Excel VBA Macro: Autofilter, Copy, Paste to New Sheet & Save new file !! Please Help Family!

highfly921 · Apr 6, 2022

Hello everyone,

Please see the file attached! I have this macro 95% done; the only issue I have is that my output data (based on sheet 2 tab list ) is only copying the first row (from the raw data tab) and not the entire dataset - I just need the macro to copy all data and paste in the "output tab" and save it as a new file based on all sheet 2 lists and just from not filtered selection; for example I want to save 3 separate files from this macro based on the codes I have listed from sheet 2 tab list.

I'm almost there but can't figure out the rows section, also I will have 100k +rows & 300+ columns so trying to have an automated process! please help family!

Thanks!

Code:

>>> use code - tags <<<

Code:

Sub filter_copy_paste_save()

Dim region As String
Dim raw As Worksheet
Dim out As Worksheet
Dim count_col As Integer
Dim count_row As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set raw = ThisWorkbook.Sheets("Raw Data")
Set out = ThisWorkbook.Sheets("Output")
region = raw.Range("h1").Text

'clear pervious data
out.Cells.ClearContents

'determine the size of the range
raw.Activate
count_col = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlToRight)))
count_row = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown))) + 2

'filter data on Raw Data tab
raw.Range("A2").AutoFilter field:=2, Criteria1:=region

'copy/paste to Output tab
raw.Range(Cells(2, 1), Cells(count_row, count_col)).SpecialCells(xlCellTypeVisible).Copy
out.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False


'show data and remove filter
With raw
    .ShowAllData
    .AutoFilterMode = False
End With

'formatting Output tab
With out
    .Activate
    .Cells.Select
    .Cells.EntireColumn.AutoFit
    .Range("A1").Select
    .Copy
End With

'save and close the workbook
ActiveWorkbook.SaveAs Filename:="folder location" & _
    "Region Report - " & region & ".xlsx"
ActiveWorkbook.Close

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

rollis13 · Apr 6, 2022

Change this:

Code:

count_row = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown))) + 2

to:

Code:

count_row = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlDown))) + 1

highfly921 · Apr 6, 2022

I receive Run-time error 6 overflow error message - appreciate the response

rollis13 · Apr 6, 2022

Your problem is elsewhere, works perfectly with your demo file.
Remember, you are using Integer for your variables.

Marc L · Apr 6, 2022

highfly921 said:
I receive Run-time error 6 overflow error message - appreciate the response

Hello, you must check the codeline raising this error.

You forgot to specify the worksheet for some ranges …

highfly921 · Apr 6, 2022

Thanks - that worked - last question in my intial ask was to save 3 separate files from this macro based on the codes listed from sheet 2 tab list; rather than selecting each option in my filter, I want the macro to save based on the list provided in the sheet 2 tab...Thanks again!

rollis13 · Apr 6, 2022

This should do, now you can work on it on your own to make the change dynamic:

Code:

Option Explicit
Sub filter_copy_paste_save()

    Dim region As String
    Dim raw    As Worksheet
    Dim out    As Worksheet
    Dim count_col As Long                         '<- changed
    Dim count_row As Long                         '<- changed
    Dim i      As Long                            '<- added

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
  
    Set raw = ThisWorkbook.Sheets("Raw Data")
    Set out = ThisWorkbook.Sheets("Output")
  
    For i = 1 To 3                                '<- added
        region = Sheets("Sheet 2").Range("A" & i).Text '<- changed
        'clear pervious data
        out.Cells.ClearContents
      
        'determine the size of the range
        raw.Activate
        count_col = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlToRight)))
        count_row = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlDown))) + 1
      
        'filter data on Raw Data tab
        raw.Range("A2").AutoFilter field:=2, Criteria1:=region
      
        'copy/paste to Output tab
        raw.Range(Cells(2, 1), Cells(count_row, count_col)).SpecialCells(xlCellTypeVisible).Copy
        out.Range("A1").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
      
        'show data and remove filter
        With raw
            .ShowAllData
            .AutoFilterMode = False
        End With
      
        'formatting Output tab
        With out
            .Activate
            .Cells.Select
            .Cells.EntireColumn.AutoFit
            .Range("A1").Select
            .Copy
        End With
      
        'save and close the workbook
        ActiveWorkbook.SaveAs Filename:="C:\Users\apatel\OneDrive - SODEXO\Desktop\Segment Overview\Test\" & _
                              "Region Report - " & region & ".xlsx"
        ActiveWorkbook.Close
    Next i                                        '<- added
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
  
End Sub

Marc L · Apr 7, 2022

If the purpose is to just create a workbook for each region so delete

the useless worksheets 'Output' & 'Sheet2' like the VBA Module1 then for starters

paste this Excel basics VBA demonstration to the Raw Data worksheet module :

Code:

Sub Demo1()
         Dim V, R&
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
         Workbooks.Add xlWBATWorksheet
    With [A2].CurrentRegion
        .Columns(2).AdvancedFilter 2, , [K1], True
         V = [K1].CurrentRegion.Value2
     For R = 2 To UBound(V)
         [K2].Value2 = V(R, 1)
        .AdvancedFilter 2, [K1:K2], ActiveSheet.[A1]
         ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Region " & V(R, 1), 51
         ActiveSheet.UsedRange.Clear
     Next
    End With
         [K1].CurrentRegion.Clear
         ActiveWorkbook.Close False
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !

highfly921 · Apr 7, 2022

Marc L said:
If the purpose is to just create a workbook for each region so delete
the useless worksheets 'Output' & 'Sheet2' like the VBA Module1 then for starters
paste this Excel basics VBA demonstration to the Raw Data worksheet module :

Code:

Sub Demo1() Dim V, R& With Application .DisplayAlerts = False .ScreenUpdating = False Workbooks.Add xlWBATWorksheet With [A2].CurrentRegion .Columns(2).AdvancedFilter 2, , [K1], True V = [K1].CurrentRegion.Value2 For R = 2 To UBound(V) [K2].Value2 = V(R, 1) .AdvancedFilter 2, [K1:K2], ActiveSheet.[A1] ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Region " & V(R, 1), 51 ActiveSheet.UsedRange.Clear Next End With [K1].CurrentRegion.Clear ActiveWorkbook.Close False .DisplayAlerts = True .ScreenUpdating = True End With End Sub

Do you like it ? So thanks to click on bottom right Like !

I received this message but the output data is blank - please advise. Thanks again!

highfly921 · Apr 7, 2022

rollis13 said:

This should do, now you can work on it on your own to make the change dynamic:

Code:

Option Explicit
Sub filter_copy_paste_save()

    Dim region As String
    Dim raw    As Worksheet
    Dim out    As Worksheet
    Dim count_col As Long                         '<- changed
    Dim count_row As Long                         '<- changed
    Dim i      As Long                            '<- added

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set raw = ThisWorkbook.Sheets("Raw Data")
    Set out = ThisWorkbook.Sheets("Output")

    For i = 1 To 3                                '<- added
        region = Sheets("Sheet 2").Range("A" & i).Text '<- changed
        'clear pervious data
        out.Cells.ClearContents
    
        'determine the size of the range
        raw.Activate
        count_col = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlToRight)))
        count_row = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlDown))) + 1
    
        'filter data on Raw Data tab
        raw.Range("A2").AutoFilter field:=2, Criteria1:=region
    
        'copy/paste to Output tab
        raw.Range(Cells(2, 1), Cells(count_row, count_col)).SpecialCells(xlCellTypeVisible).Copy
        out.Range("A1").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    
        'show data and remove filter
        With raw
            .ShowAllData
            .AutoFilterMode = False
        End With
    
        'formatting Output tab
        With out
            .Activate
            .Cells.Select
            .Cells.EntireColumn.AutoFit
            .Range("A1").Select
            .Copy
        End With
    
        'save and close the workbook
        ActiveWorkbook.SaveAs Filename:="C:\Users\apatel\OneDrive - SODEXO\Desktop\Segment Overview\Test\" & _
                              "Region Report - " & region & ".xlsx"
        ActiveWorkbook.Close
    Next i                                        '<- added
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

This worked perfectly! Just one question - how would I change the code below to make sure it recognizes all the cells with values/text so I don't have to keep changing "3" to 5 or 10 or 100, etc. as the data add on daily (in sheet 2 tab)...again thank you so much!

>>> use code - tags <<<

Code:

For i = 1 To 3                                '<- added
        region = Sheets("Sheet 2").Range("A" & i).Text '<- changed
        'clear pervious data
        out.Cells.ClearContents

rollis13 · Apr 7, 2022

I see that you are not doing anything on your own

, this was a simple and intuitive modification

.
Use these two changes:

Code:

'...
Set out = ThisWorkbook.Sheets("Output")
Dim LR     As Long                            '<- added
LR = Sheets("Sheet 2").Range("A" & Rows.Count).End(xlUp).Row '<- added
For i = 1 To LR                               '<- changed
    region = Sheets("Sheet 2").Range("A" & i).Text
'...'

Marc L · Apr 7, 2022

highfly921 said:
I received this message but the output data is blank

As it works like a charm on my side so you did not well follow the post #8 direction

then you felt in the bad reader trap or you did not run it on your own attachment …

highfly921 · Apr 7, 2022

rollis13 said:
I see that you are not doing anything on your own , this was a simple and intuitive modification .
Use these two changes:

Code:

'... Set out = ThisWorkbook.Sheets("Output") Dim LR As Long '<- added LR = Sheets("Sheet 2").Range("A" & Rows.Count).End(xlUp).Row '<- added For i = 1 To LR '<- changed region = Sheets("Sheet 2").Range("A" & i).Text '...'

Sorry - I'm proficient and still learning macros - appreciate the extra help!

highfly921 · Apr 7, 2022

Marc L said:
As it works like a charm on my side so you did not well follow the post #8 direction
then you felt in the bad reader trap or you did not run it on your own attachment …

This works! I have multiple versions of excel so had to open it in the right one to make it work properly without any modifications! Again, this is perfect! Thanks so much!

Marc L · Apr 7, 2022

My demonstration reproduces what any Excel user can operate manually just using Excel basics whatever the Excel version …

highfly921 · Apr 8, 2022

Marc L said:
My demonstration reproduces what any Excel user can operate manually just using Excel basics whatever the Excel version …

Hey Marc - I've enhanced my files for my sales team so they can also refresh a pivot table tab with the macro below, the only issue I'm running into is that I want to have the new workbook saved (from your macro) to include pivot table tab and to refresh the pivots from the code below before saving the file to my location - could you please guide me here? For example, the new saved workbook should have two tabs, one the raw data and other is pivot table tab. any help would be appreciated. Thanks again!

Code:

>>> as many times asked <<<
>>> use code - tags <<<

Code:

Sub Refresh_All_Pivot_Table_Caches()

'Refresh all pivot caches in the workbook.
'Pivot tables are automatically refreshed when cache is refreshed.


Dim pc As PivotCache

  'Refresh all pivot tables
  For Each pc In ThisWorkbook.PivotCaches
    pc.Refresh
  Next pc
 
End Sub

Marc L · Apr 8, 2022

As there is no pivot table within your attachment …

highfly921 · Apr 8, 2022

Marc L said:
As there is no pivot table within your attachment …

Sorry about that, see attached pivot with updated macro and pivot table - thanks again !!

Marc L · Apr 9, 2022

highfly921 said:
the new saved workbook should have two tabs, one the raw data and other is pivot table tab

Which one as your attachment contains two pivot tables ?

highfly921 · Apr 9, 2022

Marc L said:
Which one as your attachment contains two pivot tables ?

Feel free to delete one of the pivot tab, doesn't matter. It was a sample to show just to export two tabs. Appreciate it thanks

Marc L · Apr 9, 2022

According to the post #18 attachment my VBA demonstration revamped to paste to the Raw Data worksheet module :

Code:

Sub Demo1r()
         Dim V, R&
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
         Sheet3.PivotTables(1).RefreshTable
         Sheets(Array(Name, Sheet3.Name)).Copy
    With [A2].CurrentRegion
        .Columns(2).AdvancedFilter 2, , [K1], True
         V = [K1].CurrentRegion.Value2
     For R = 2 To UBound(V)
         [K2].Value2 = V(R, 1)
         ActiveSheet.UsedRange.Clear
        .AdvancedFilter 2, [K1:K2], ActiveSheet.[A1]
         ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Region " & V(R, 1), 51
     Next
    End With
         [K1].CurrentRegion.Clear
         ActiveWorkbook.Close
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

You may Like it !

highfly921 · Apr 9, 2022

Marc L said:

According to the post #18 attachment my VBA demonstration revamped to paste to the Raw Data worksheet module :

Code:

Sub Demo1r()
         Dim V, R&
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
         Sheet3.PivotTables(1).RefreshTable
         Sheets(Array(Name, Sheet3.Name)).Copy
    With [A2].CurrentRegion
        .Columns(2).AdvancedFilter 2, , [K1], True
         V = [K1].CurrentRegion.Value2
     For R = 2 To UBound(V)
         [K2].Value2 = V(R, 1)
         ActiveSheet.UsedRange.Clear
        .AdvancedFilter 2, [K1:K2], ActiveSheet.[A1]
         ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Region " & V(R, 1), 51
     Next
    End With
         [K1].CurrentRegion.Clear
         ActiveWorkbook.Close
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

You may Like it !

That works perfectly! Thanks - I didn't realize the output data pivot would be linked to the original dataset (from raw data tab). I was hoping the new workbook to be linked to the raw data within the respective region file when it's saved - Thanks again with any guidance you can provide here!

Marc L · Apr 9, 2022

It's what you explained in post #16 : copy the source sheet and a pivot sheet …

That's difficult to guess without any expected result attachment.

highfly921 · Apr 9, 2022

Marc L said:
It's what you explained in post #16 : copy the source sheet and a pivot sheet …

That's difficult to guess without any expected result attachment.

I understand - please see attached - the main file reflects the updated macro with the pivot tables and the new workbook (region xxx) is where I would like to have the pivot table source data link to the region 50-123 file within "raw data tab" ( not the raw data from the main file) as the pivot table would not reflect filtered data properly. I hope that makes sense

. Basically, the new workbook should have the pivot table linked to the raw data tab. appreciate your feedback!

Marc L · Apr 9, 2022

According to the previous post attachment my revamped demonstration revised in order to allocate locally the pivot table source data,

to paste to the Raw Data worksheet module :

Code:

Sub Demo1r2d2()
         Dim V, R&
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
         Sheets(Array(Name, Sheet3.Name)).Copy
    With [A2].CurrentRegion
        .Columns(2).AdvancedFilter 2, , [K1], True
         V = [K1].CurrentRegion.Value2
     For R = 2 To UBound(V)
         [K2].Value2 = V(R, 1)
         ActiveSheet.UsedRange.Clear
        .AdvancedFilter 2, [K1:K2], ActiveSheet.[A1]
         ActiveSheet.Next.PivotTables(1).SourceData = ActiveSheet.[A1].CurrentRegion.Address(, , xlR1C1, True)
         ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Region " & V(R, 1), 51
     Next
    End With
         [K1].CurrentRegion.Clear
         ActiveWorkbook.Close
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

You should Like it !

Excel VBA Macro: Autofilter, Copy, Paste to New Sheet & Save new file !! Please Help Family!

New Member

Attachments

Member

New Member

Member

Excel Ninja

New Member

Member

Excel Ninja

New Member

New Member

Member

Excel Ninja

New Member

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Attachments

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Attachments

Excel Ninja