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

• #27478 Delila_1 veterán Melack #27477

  Új Válasz 2015-06-22 09:15:49 #27478

  Ú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 Melack #27477 üzenetére

  A próbánál a füzet utolsó lapját elneveztem Gyűjtés-nek. A MitKeres változóba tettem be a keresendő adatot.
  A makró az elsőtől az utolsó előtti lapig megkeresi a MitKeres értéket, és a találat sorát a Gyűjtés lap első üres sorába bemásolja.

  Sub Kigyujt()
  Dim lap As Integer, WSG As Worksheet, Hol, usor As Long
  
  Application.ScreenUpdating = False
  Const MitKeres = "Máté" 'Itt add meg a keresendő értéket
  Set WSG = Sheets("Gyűjtés")
  
  WSG.Rows("2:2000") = ""
  For lap = 1 To Worksheets.Count - 1
  Sheets(lap).Select
  Set Hol = Cells.Find(MitKeres, LookIn:=xlValues, lookat:=xlWhole)
  If Hol Is Nothing Then
  GoTo Tovabb
  Else
  usor = WSG.Range("A" & Rows.Count).End(xlUp).Row + 1
  Rows(Hol.Row).Copy WSG.Range("A" & usor)
  End If
  
  
  Tovabb:
  On Error GoTo 0
  Next
  
  WSG.Select
  Application.ScreenUpdating = True
  End Sub

  Ez laponként az első találatot teszi ki. Ha több kell, valaki biztosan segít, most el kell mennem.

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