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

• #24071 Delila_1 veterán gyu84 #24070

  Új Válasz 2014-11-05 11:33:06 #24071

  Ú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 gyu84 #24070 üzenetére

  Próbáld meg a lenti makróval.

  Sub Kigyujtes()
  Dim sor As Long, WF As WorksheetFunction, uoszlop As Integer
  Set WF = Application.WorksheetFunction
  
  Sheets(4).Activate
  sor = 1
  Do While Cells(sor, 1) <> ""
  uoszlop = Cells(sor, Columns.Count).End(xlToLeft).Column + 1
  If WF.CountIf(Sheets(1).Columns(1), Cells(sor, 1)) > 0 Then
  Cells(sor, uoszlop) = _
  WF.VLookup(Cells(sor, 1), Sheets(1).Range("A:B"), 2, 0)
  uoszlop = uoszlop + 1
  End If
  
  If WF.CountIf(Sheets(2).Columns(1), Cells(sor, 1)) > 0 Then
  Cells(sor, uoszlop) = _
  WF.VLookup(Cells(sor, 1), Sheets(2).Range("A:B"), 2, 0)
  uoszlop = uoszlop + 1
  End If
  
  If WF.CountIf(Sheets(3).Columns(1), Cells(sor, 1)) > 0 Then
  Cells(sor, uoszlop) = _
  WF.VLookup(Cells(sor, 1), Sheets(3).Range("A:B"), 2, 0)
  End If
  
  sor = sor + 1
  Loop
  
  End Sub

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