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

• #23724 Delila_1 Topikgazda Delila_1 #23723

  Új Válasz 2014-10-15 10:06:02 #23724

  Ú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

  Topikgazda

  válasz Delila_1 #23723 üzenetére

  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

  Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

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