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
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Forum statistics

Threads
1,214,932
Messages
6,122,323
Members
449,077
Latest member
jmsotelo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top