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

• #23723 Delila_1 veterán slashing #23720

  Új Válasz 2014-10-15 09:32:49 #23723

  Ú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 slashing #23720 üzenetére

  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