Excel VBA Macro: Autofilter And Copy to New Workbook (Dynamic Range)
HTML-код
- Опубликовано: 29 окт 2020
- Excel VBA Macro: Autofilter And Copy to New Workbook (Dynamic Range). In this video, we go over how to automatically copy and paste filtered data from one workbook to a new workbook. We then save the new workbook based on a cell value that we used to filter the data. We also go over how to handle overwriting data when saving. One way is to use Application.DisplayAlerts = False/True to avoid the issue all together and have the macro always overwrite the existing workbook. The other way is to use On Error Resume Next to handle an error caused when the user selects "No" when asked to overwrite data.
Data used in this video:
gsociology.icaap.org/datauplo...
#ExcelVBA #ExcelMacro
Great Video Greg! Helped me automate many weekly reports! Thank you so much!
So glad to hear that! No problem!
Thank you so much for your help! I have been watching your videos and playing with code the past two days and was able to use this and the other code you have for PDF to make a loop for this but export to Excel. The only thing different is I made the data validation list in A1 on sheet 1 and then my column for region was named organization and I changed it to be under Column A(2).
Sub copy_data_2_new_book()
Dim count_col As Integer
Dim count_row As Integer
Dim og As Worksheet
Dim wb As Workbook
Dim organization As String
Dim i As Long
Set Data = ThisWorkbook.Sheets(1)
Set List = ThisWorkbook.Sheets(2)
'count numnber of regions
List.Activate
Count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
Data.Activate
For i = 1 To Count
'updating the region name
organization = List.Cells(i, 1).Text
Data.Cells(1, 1) = organization
Set og = Sheet1
organization = og.Cells(1, 1).Value
Set wb = Workbooks.Add
wb.Sheets("Sheet1").Name = organization
og.Activate
count_col = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlToRight)))
count_row = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlDown)))
ActiveSheet.Range("A2").AutoFilter Field:=1, Criteria1:=organization
'copies data from sheet to workbook
og.Range(Cells(1, 1), Cells(count_row, count_col)). _
SpecialCells(xlCellTypeVisible).Copy
wb.Sheets(organization).Cells(1, 1).PasteSpecial xlPasteValues
wb.Sheets(organization).Cells(1, 1).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
og.ShowAllData
og.AutoFilterMode = False
wb.Activate
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
'save and close
On Error Resume Next
Application.DisplayAlerts = False
wb.SaveAs "/Users/To Be Sorted/" & _ organization & " " & Format(Date, "mm-dd-yyyy") & ".xlsx"
Application.DisplayAlerts = True
wb.Close 'savechanges:=False
Next i
End Sub
Thanks for this, Greg! One enhancement I need is a prompt for the "region" instead of either preselecting it from a dropdown or looping through the entire list. Hopefully that's not too difficult to add.
combined it with an Excel VBA Form where the textbox prompts for 'region' works too
Thank you.
No problem!
Hi Greg, thanks for the video
Very clear and I learn a lot and make me more interested with macro.
I m trying to do the same thing as your video.
That is, taking data filter it according to specific shop and save to its respective files in another folder but I need to the files to be remained in the folder. They should be updated instead and not deleted and replaced by new ones. This is so because the access of each file is shared with a list of sales people and they can access the file on their mobiles. If I do it the same way as you, when they will click on the file, they will not able to access. I am thinking that it will need to create a loop so that each is opened and each one is updated or overwrite and then the each file is closed. Can you please help me with the code as I m not able to make it work? 😥
very nice .....
Thanks!
Can this possible to Save Active Sheet As Multiple Workbook like you did in Excel VBA Macro: Save Active Sheet As Multiple PDFs (Based on List of Cell Values)?
Hi - thanks for this. This is what I need but I want to loop through the drop down instead of selecting each one individually. I looked at the other loop for video you posted but that creates PDF. So I basically need a merge of this code and the loop one to auto create all files at once for excel. Then attach that to an email per 'client' (region in your example). I tried to do this myself but got errors. Can you assist please?
No prob. So you want code that auto creates all files from a list and sends each file to a different email address?
How to add extra codes so that we can produce 200 new workbooks if the list has 200 regions using the macro instead we click the drop down list 200 times?
You can create a loop that will loop through the list; creating a new workbook each time. I’ll make a video on that asap
@@greggowaffles I'd like to see this tutorial as well, can you please link the new video if you published it already? Thanks man!
I have a list of regions and would like to run a macro for about 20 regions out of the data set. What code can I add to do this versus individually selecting the regions and clicking run. Thank you for the help this video was great!
You want to create a new tab for each value in the list in another workbook all at once?
@@greggowaffles I want to create a new workbook for 1 region but I don't want to select the region from the dropdown list and run each time (in cases where I need 20 regions/20 separate workbooks). Is it possible to add code so it will automatically run for Region 1, 5, 11, 15, etc.) and create a separate workbook for each specific one I identify in the code.
Yeah, you can create a list and have the macro go down the list with a loop. I’ll make a video on this
@@marcod7393 you can use the logic for the loop from this video: ruclips.net/video/CtAgAlJjleU/видео.html hope it helps!
Unable to understand as code is not visible
Could I get the code. thanks
Sub copy_data_2_new_book()
Dim count_col As Integer
Dim count_row As Integer
Dim og As Worksheet
Dim wb As Workbook
Dim region As String
Set og = Sheet1
region = og.Cells(2, 6).Value
Set wb = Workbooks.Add
wb.Sheets("Sheet1").Name = region
og.Activate
count_col = WorksheetFunction.CountA(Range("A4", Range("A4").End(xlToRight)))
count_row = WorksheetFunction.CountA(Range("A4", Range("A4").End(xlDown)))
ActiveSheet.Range("A4").AutoFilter Field:=2, Criteria1:=region
'copies data from sheet to workbook
og.Range(Cells(4, 1), Cells(count_row, count_col)). _
SpecialCells(xlCellTypeVisible).Copy
wb.Sheets(region).Cells(1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
og.ShowAllData
og.AutoFilterMode = False
wb.Activate
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
'save and close
On Error Resume Next
Application.DisplayAlerts = False
wb.SaveAs "C:\Users\greggowaffles\Documents\Test\" & _
region & " " & Format(Date, "mm-dd-yyyy") & ".xlsx"
Application.DisplayAlerts = True
wb.Close 'savechanges:=False
End Sub
share the code, please
add the loop , below is the code
Dim i As Integer
Dim og As Worksheet
Dim wb As Workbook
Dim tin As String
Dim count_col As Integer
Dim count_row As Integer
i = 1
Do Until i = 2
i = i + 1
Sheets("Template").Select
Set og = Sheets("Template")
og.Cells(2, 3).Value = i
Calculate
tin = og.Cells(2, 4).Value
Set wb = Workbooks.Add
wb.Sheets("Sheet1").Name = tin
og.Activate
count_col = WorksheetFunction.CountA(Range("A6", Range("A6").End(xlToRight)))
count_row = WorksheetFunction.CountA(Range("A6", Range("A6").End(xlDown)))
ActiveSheet.Range("A6").AutoFilter Field:=6, Criteria1:=tin
'copies data from sheet to workbook
og.Range(Cells(6, 1), Cells(count_row, count_col)). _
SpecialCells(xlCellTypeVisible).Copy
wb.Sheets(tin).Cells(1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
og.ShowAllData
og.AutoFilterMode = False
wb.Activate
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
'save and close
'On Error Resume Next
Application.DisplayAlerts = False
wb.SaveAs "C:\Users\wyu\Documents\Test_2021.12\" & _
tin & " " & Format(Date, "mm-dd-yyyy") & ".xlsx"
wb.Close 'savechanges:=False
Application.DisplayAlerts = False
Loop
End Sub
This didn't work for me created some errors
I am getting an error with your code
the error occurs at
wb.Sheets("Sheet1").Name = region
Run-time error 'error':
Application-defined or object-defined error
Is it possible you can post your excel
You need to use quotations around region: “region”. Im working on adding the code to the descriptions of all of my videos now
Thanks it helped me
BUT
Again further down in programming there come an new error
wb.Sheets(region).Cells(1, 1).PasteSpecial xlPasteValues
I then again set quatations around region
ug.Sheets("region").Cells(1, 1).PasteSpecial xlPasteValues
again it help me and all ok
BUT why do your script in the video "with no use of quotation around region" not failed ?
is is because of a new VBA statement or ?
My region is a variable that’s equal to a cell on the worksheet. Can you post your entire code here? I can take a look and see what’s happening
my code is ok now; thanks for help
@@kennethjensen5985 no prob! Glad to hear that!