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

Vbapadawan

New Member
Joined
Jul 5, 2015
Messages
13
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???

Code:
 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
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
                    ws.Delete
                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
                        .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
                                
                            Else
                            GoTo 10
                            End If
                          
                                                   
                      .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1")
                      Sheets(c.Value).Columns.AutoFit
                    End With

1
Next c
        End With
         End If
    Next ws
    Application.ScreenUpdating = True
    GoTo 100
10
'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)
    
 Sheets(c.Value).Columns.AutoFit
    GoTo 1
   On Error Resume Next
   
100
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

Threads
1,095,361
Messages
5,444,020
Members
405,260
Latest member
Khauff

This Week's Hot Topics

Top