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

• Delila_1 veterán

  #23724

  #23723 Delila_1

  2014-10-15 10:06:02

  Ú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

  #23723 Delila_1

  Meg is van.

  Sub Oszlopok_1()
  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
  sorhova = WS2.UsedRange.Rows.Count + 1
  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
  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