Delila10 Creative Commons License 2013.02.14 0 0 20380

Nem írtad, hogy a kigyűjtés eredménye az aktuális-, vagy egy másik füzetbe kerüljön.

A makrót az első szerint írtam meg. Első lap legyen egy egyelőre üres, Gyűjtő nevű.

 

Sub A_kigyujtes()
    Dim usor As Integer, Rng As Range, lap As Integer, usorGy As Integer
    Application.ScreenUpdating = False
    
    Sheets("Gyűjtő").Cells = ""
    
    For lap = 2 To Sheets.Count
        Sheets(lap).Select
        If lap = 2 Then Rows(1).Copy Sheets("Gyűjtő").Range("A1")
            
        Selection.AutoFilter Field:=1, Criteria1:="A"
        usor = Cells(Rows.Count, 1).End(xlUp).Row
        Set Rng = Range(Rows(2), Rows(usor))
        Set Rng = Rng.SpecialCells(xlCellTypeVisible)
        usorGy = Sheets("Gyűjtő").Cells(Rows.Count, "A").End(xlUp).Row + 1
        Rng.Select
        Selection.Copy Sheets("Gyűjtő").Range("A" & usorGy)
    Next
    
    Sheets("Gyűjtő").Select
    Application.ScreenUpdating = True
End Sub

 

Előzmény: Tie (20379)