Hirdetés

Keresés

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

  • 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