Copying data based on filter criteria

[no_rhythm]

I have a workbook with a series of worksheets (more than 25). I need to do
the following:
For each worksheet 2 through 'n'
Sort/Filter on column M "Impact" for Impact = Global
Copy all data (about 15 columns) for each row with Impact = Global and paste
rows into Worksheet1 starting with Cell B24 down

So, for the next worksheet (i.e. Worksheet 3), the paste function should
remember the last row written and begin pasting from the next row.

Please let me know how to do this. I have limited knowledge of Macros /
Pivot Tables and Programming using VB

 

[JP]

Hello,

This will do most of what you want. For some reason I can't get the
code to stop copying the headers, after the first time. Also, you'll
have to adjust the code to start pasting from row 24, but it's a
start.

Sub autofiltervisibleandcopytonewwkbk()
' This will add a new worksheet to your workbook, go through each
worksheet, filter on column M for word "Global", copy filtered rows to
the new workbook
Dim rng As Excel.Range
Dim NewSht As Worksheet
Dim i As Integer

Application.ScreenUpdating = False

Set NewSht = Sheets.Add(After:=Sheets(Sheets.count))
Sheets(1).Activate
sheetnum = 1
For i = 1 To Worksheets.count - 1
Sheets(i).Activate
ActiveSheet.UsedRange
Set rng = ActiveSheet.UsedRange.Rows
With rng
.AutoFilter Field:=13, Criteria1:="=Global"
End With

With ActiveSheet.AutoFilter.Range
On Error Resume Next
If sheetnum > 1 Then
Set rng = .Offset(0, 0).Resize(.Rows.count - 1, _
.Columns.count).SpecialCells(xlCellTypeVisible)
Else
Set rng = .Offset(0,
0).Resize(.Rows.count, .Columns.count).SpecialCells(xlCellTypeVisible)
End If
On Error GoTo 0
End With
If sheetnum > 1 Then

rng.Copy NewSht.Range("A65536").End(xlUp).Offset(1, 0)
Else
rng.Copy NewSht.Range("A65536").End(xlUp)
End If
sheetnum = sheetnum + 1
Next i

Application.ScreenUpdating = True
End Sub