Copy, paste Autofilter range without headings to another sheet. not working


New Member
Jul 5, 2015
I'm happy with the way the code works (thanks Skywriter), I have worked out how to append the filtered data to an existing sheet if it already exists, but I just cant seem to do it without the heading row.
I have followed the code in the multiple posts on the subject but keep getting a runtime 1004 error. stopping on the code below
What am I doing wrong???

 Rng2.Offset(1, 0).Resize(Rng2.Rows.Count - 1) _
            .SpecialCells(xlCellTypeVisible).Copy Sheets(c.Value).Range("A" & MaxRows + 1)
View attachment 68223

Here is the entire code
Option Explicit
Sub Split_worksheet()
    Dim c As Range
    Dim rng As Range
    Dim Rng2 As Range
    Dim LR As Long
    Dim MaxRows As Long
    Dim ws As Worksheet
  Application.ScreenUpdating = False
 ' Turn off alerts so the sheets will be deleted without having to acknowledge them.
Application.DisplayAlerts = False
    For Each ws In Worksheets
                If Not ws.Name Like "Report Sheet*" And Not ws.Name = "COUNT" Then
                End If
    Next ws
Application.DisplayAlerts = True

    ' Loop through remaining sheets which all begin with "Report Sheet", new sheets added are not looped.
    For Each ws In Worksheets
    If Not ws.Name = "COUNT" Then
    MsgBox ws.Name
        With ws
     If .AutoFilterMode = True Then .AutoFilterMode = False
        LR = .Cells(Rows.Count, "A").End(xlDown).Row
       ' RR = .Cells(Rows.Count, "A").End(xlDown).Row
        Set rng = .Range("A1:AF" & LR)
        ' Create a unique list of manager names in column AM.
        .Columns("AM").ClearContents '  Clear any existing data.
        .Range("AF1:AF" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("AM1"), Unique:=True
             ' Loop through the unique list of manager names. Autofilter the data based on those names.
             ' Create a new sheet based on the manager name. If a sheet with the manager's name already exists
             ' then do not create a a new sheet just go to the next manager and try again.
             For Each c In .Range("AM2", .Cells(Rows.Count, "AM").End(xlUp)) '
                      With rng
                        .AutoFilter Field:=32, Criteria1:=c.Value
                            ' Check if a sheet with the manager's name already exists. It it does do not add a sheet just
                            ' skip to the next manager's name and try again.
                            If Not Evaluate("ISREF('" & c.Value   & "'!A1)") Then  ' Check if the worksheet already exists.
                                Sheets.Add(After:=Sheets(Worksheets.Count)).Name = c.Value
                            GoTo 10
                            End If
                      .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1")
                    End With

Next c
        End With
         End If
    Next ws
    Application.ScreenUpdating = True
    GoTo 100
'If the sheet already exists, the data is added to existing sheet
'find next blank cell in target sheet
MaxRows = Sheets(c.Value).Cells(Rows.Count, "A").End(xlUp).Row
' Set rng to the visible cells in My_Range without the header row
   'copy rows without headings
'ws.AutoFilter.Range.Copy Sheets(c.Value).Range("A" & MaxRows + 1) ' works but includes headings
 Set Rng2 = ws.AutoFilter.Range
 Rng2.Offset(1, 0).Resize(Rng2.Rows.Count - 1) _
            .SpecialCells(xlCellTypeVisible).Copy Sheets(c.Value).Range("A" & MaxRows + 1)
    GoTo 1
   On Error Resume Next
End Sub

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

Watch MrExcel Video

Forum statistics

Latest member

This Week's Hot Topics