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

• Delila_1 veterán

  2014-10-15 09:32:49 #23723

  Új Válasz

  Ú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

  

  Delila_1

  veterán

  válasz slashing üzenetére #23720

  Nem teljesen olyan, mint a képen, de hasonlít. Ha kevesebb dolgom lesz, megpróbálom azt a formát kihozni.

  Sub Oszlopok()
  Dim WS1 As Worksheet, WS2 As Worksheet, sor As Long, usor As Long
  Dim oszlop As Integer, uoszlop As Integer, cim As String, oszlophova As Integer
  Dim WF As WorksheetFunction, sorhova As Long
  
  Set WS1 = Sheets("Munka1")
  Set WS2 = Sheets("Munka2")
  Set WF = Application.WorksheetFunction
  sor = 1
  
  WS1.Select
  
  Do While Cells(sor, 1) <> ""
  uoszlop = WS1.Range("A" & sor).End(xlToRight).Column
  For oszlop = 1 To uoszlop
  cim = Cells(sor, oszlop)
  On Error GoTo Tovabb
  oszlophova = WF.Match(cim, WS2.Rows(1), 0)
  Cells(sor + 1, oszlop).Select
  usor = Selection.End(xlDown).Row
  sorhova = WS2.Cells(Rows.Count, oszlophova).End(xlUp).Row + 1
  Range(Cells(sor + 1, oszlop), Cells(usor, oszlop)).Copy WS2.Cells(sorhova, oszlophova)
  
  Tovabb:
  On Error GoTo 0
  Next
  sor = Range("A" & sor).End(xlDown).Row
  sor = Range("A" & sor).End(xlDown).Row
  Loop
  End Sub

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