Új hozzászólás Aktív témák

• #27631 Delila_1 veterán RedHarlow #27630

  Új Válasz 2015-07-07 17:17:39 #27631

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz RedHarlow #27630 üzenetére

  Így már rendben.

  A füzetben az első lap az, amin ömlesztve vannak az adatok. Ezt követi a két lap, ahova másolni kell.
  A makróban két helyen szerepel a
  Sheets(Array("Munka2", "Munka3")).Select
  sor, ezekben írd át a Munka2 és Munka3 lapneveket a füzetedben lévő 2. és 3. lap nevére.

  Szerk.: persze az X1–X4 és Y1–Y6 adatokat is írd át!

  Sub SzetCincal()
  Dim nev As String, sor As Long, usor As Long, usorIde As Long
  Dim WS As Worksheet, WSIde As Worksheet, lap As Integer
  
  Set WS = Sheets(1)
  
  'Előző adatok törlése
  Sheets(Array("Munka2", "Munka3")).Select
  Cells.Select
  Selection.ClearContents
  
  'Címsor a 2 lapra
  WS.Rows("1:1").Copy
  Sheets(Array("Munka2", "Munka3")).Select
  Range("A1").PasteSpecial xlPasteValues
  
  'Szortírozás
  WS.Select
  usor = Range("A" & Rows.Count).End(xlUp).Row
  For sor = 2 To usor
  nev = Cells(sor, 6)
  Select Case nev
  Case ""
  If Cells(sor, 5) = "Y1" Or Cells(sor, 5) = "Y2" Or _
  Cells(sor, 5) = "Y3" Then lap = 2
  If Cells(sor, 5) = "Y4" Or Cells(sor, 5) = "Y5" Or _
  Cells(sor, 5) = "Y6" Then lap = 3
  Case "X1", "X2"
  lap = 2
  Case "X3", "X4"
  lap = 3
  Case Else
  GoTo Tovabb
  End Select
  
  Set WSIde = Sheets(lap)
  usorIde = WSIde.Range("A" & Rows.Count).End(xlUp).Row + 1
  Rows(sor).Copy WSIde.Range("A" & usorIde)
  Tovabb:
  Next
  End Sub

Új hozzászólás Aktív témák