Copy Filtered Data To New Sheets Excel VBA Macro
HTML-код
- Опубликовано: 8 июл 2024
- In this video we see how to filter data and copy to new sheets in Excel using VBA macros. Excel offers filter options to easily narrow down the data. This macro example activates the filter option with VBA, and copies the filtered data for each unique entry to separate sheets. Find the code to copy filtered data to new sheets with Excel VBA in the Excel Macro Class blog under the following link: excelmacroclass.blogspot.com/...
You can find many other macro examples and Excel VBA learning materials (including a training for beginners) in the blog under the link: excelmacroclass.blogspot.com/
And yet, if you want more, you can find various Excel applications of different nature in the other blogs of the Excel Macro Mania saga:
Excel Macro Fun (excelmacrofun.blogspot.com/)
Excel Macro Business (excelmacrobusiness.blogspot.com/)
Excel Macro Sports (excelmacrosports.blogspot.com/)
I can't believe this incredible video is free. Thank you so much brother.
Thank you very much!
This video really made my work easier at the office.
Life savior...Been doing things the long way...
Sir, you are my hero. Thank you!!!
A marvel of knowledge and impeccable execution.
Excellent 10/10
Thanks for the feedback. Best regards!
Thank you so much sir⭐️⭐️⭐️⭐️⭐️⭐️
superb macro
Awesome!
amazing tricks
Super Duper coding....Written without testing....
Good video keep up bro
can you help me if i need to copy it to new workbooks not sheets? and can it autosave file with the name of the file like a filtered data name. (so the file will be save named toyota, citroen, etc).
pls help, thankyou before🙂
That's covered in this other video: ruclips.net/video/9GgjoF7eJsg/видео.htmlsi=XWEGQxxlU7ky448c
hi but the diplicates are also copying for me and empty shhets are created can you help mw with solution
See the comments by ZMedrano, that's probably the same case. Start from row 2 instead of 1 (skip headers). I also wrote other possibilities for that problem in the reply to that comment below.
Man, this helped me a lot
I have one question. How can I add certain information in every worksheet?
In your example, I want to count the number of cars with that brand and put the number on cell E5 for every worksheet. How can I do that?
Add this after pasting the data in the new sheet.
itemsCount=Sheets(brandName).Range("A1").CurrentRegion.Rows.Count - 1 'the -1 is to skip the header, otherwise remove it
Sheets(brandName).Range("E5").Value = itemsCount
Can you help me copy only the visible data and paste and append it on existing data?..thanks
Sheet1.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Sheet2.Range("A1")
Change Sheet1 and Sheet2 as needed, and specify the destination range in Sheet2. You have an example of this macro here: excelmacroclass.blogspot.com/2020/07/copy-filtered-data-to-new-sheets.html
hi man, I have a sheet that has about 20000 records, and I did the same as your code, but I got one filter, example the shows just Toyota , please can you help me to fix this issue please , appreciate you pation
Not sure what your issue is. You may need to change the field if you filter by a column different than column A (which is field 1).
thank you. this helped me a lot. I want to paste without column A. I mean I want to paste only column B and C. What should I do? I mean, for toyota worksheet column A is empty, cell B2 Auris cell C2 2004 cell B3 Yaris C3 2010 and so on.
You need to change the line where you copy the data, which is taking the whole region (columns A, B, and C):
ws.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
add a line to get the last row with content before starting the loop:
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
and then replace the previous line with this one - which is specific to get the content in column B and C:
ws.Range("B1:C" & lr).SpecialCells(xlCellTypeVisible).Copy
Hello is a way to save all the excel spreadsheets with the name of the site to one area? Also how do you stop the loop?
Check this other video: ruclips.net/video/9GgjoF7eJsg/видео.html
That's saving each worksheet to a separate workbook. Here's how you save it:
ActiveWorkbook.SaveAs Filename:=wbPath & "\" & wsName
*ActiveWorkbook or Workbooks("your workbook.xlsx")
*wbPath needs to be defined before with exact path wbPath=("C:\...\...") or wbPath=ActiveWorkbook.Path if you want it in the same location
*wsName also needs to be defined, is the name of the worksheet. If you look through each worksheet, then declare ws as worksheet and do ws.Name
The loop in this example is a For loop, therefore, you can set the exact number of loops (For x=1 to 10). If you want to break the loop you use: Exit For
This is great however, I am also getting 380+ blank sheets created. There are no blank fields in the column I am referencing. Any idea how to just get the sheets I need?
Not sure I understand. You get 380+ sheets created because you have 380+ unique entries in the reference column (column A in the video), or you have less than 380+ unique entries and actually the entire dataset is 380+ rows long? In the second case, the macro is actually adding a new sheet for each row, I wonder what's the name of those worksheets... there might be something wrong with the main conditional statement that checks if sheet already exists (or actually is a sheet with that name does NOT exist - sheet is nothing.
@@ExcelMacroMania So my worksheet is 2354 rows. I have 29 unique entries in Column A. Those 29 entries become their own worksheets (as desired) but I end up getting about 380 blank sheets created as well. The names of these sheets are: Sheet1, Sheet 2, Sheet 3, and so on until the last one is created.
I use the following:
Sub CopyFilteredDataToNewSheets()
Dim r As Integer, SchoolName As String, ws As Worksheet
Set ws = ActiveSheet
ws.Range("A1:AP1").AutoFilter
Do
r = r + 1
school = ws.Range("A" & r).Value
On Error Resume Next
If Sheets(school) Is Nothing Then
ws.Range("A1:AP1").AutoFilter Field:=1, Criteria1:=school
ws.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add.Name = school
Sheets(school).Paste
ws.ShowAllData
End If
Loop While ws.Range("A" & r + 1).Value ""
End Sub
@@zee07shortie The code looks good, just declare "school" as String (you declared SchoolName), otherwise is a Variant and could take other form for example if there are numbers.... Also, the Do loop starts from row 1, and you probably have headers, so add r=1 before the Do loop, to start on row 2, otherwise, it will filter by the header and create and unwanted sheet probably. Maybe there could be some characters in the school names in column A that Excel does not recognize,... or maybe you have some trailing space in some cells, not sure, I cannot replicate your error. Try to change the Do loop for a For loop with exact numbers too and see (For r=1 to 2354). But the problem definitely is around the variable "school" that seems to come empty or wrong sometimes. You can also use a modified version of the code that I explained in this other video, to get the list of unique entries first - ruclips.net/video/jyHcAOqkRZE/видео.html
@@ExcelMacroMania Thank you so much, the r=1 before Do made the difference.
Thank you for your brilliant tutorial. I have a question, hopefully this makes sense. I have read through the comments and learnt how to only copy over 3 of the columns however I need them to paste in a different order. That is I need to copy column B, F & Z but have Z appear in column A, B in column B and F in Column C in the new work sheet. Any suggestions? Thank you
Not to worry, I found my own answer by insertings
Columns("C").Cut
Columns("A").Insert Shift:=xlToRight
After
ws.ShowAllData
😁
@@clairebeech3258 Great to know you have figured it out by yourself! You could also replace the line that copies the current region with in dividual copy/paste columns, for example:
...
Sheets.Add.Name = brandName
Sheets("All").Columns("B").SpecialCells(xlCellTypeVisible).Copy Sheets(brandName).Columns("B")
Sheets("All").Columns("F").SpecialCells(xlCellTypeVisible).Copy Sheets(brandName).Columns("C")
Sheets("All").Columns("Z").SpecialCells(xlCellTypeVisible).Copy Sheets(brandName).Columns("A")
I tried this same code for 1 st time it worked but now it's ain't working
Hmm, weird. Well, make sure you start filtering from row 2 (exclude headers). Also make sure you are showing all data (ActiveSheet.ShowAllData). It could be something with the way you get the "brandName". Don't know what else could it be. Add "On Error GoTo 0" after checking If Sheets(brandName) Is Nothing, that will allow to break in the line that produces the error (if any).
Hi, new subscriber here
Background: i have a master spreadsheet at work, the sheet has thousands of rows and dozens of columns. 1 of the main columns has the names of a significant number of staff members (which are not in order because rows have been gradually added over time to represent that staff member - which brings me to my question)
Question: i want these staff members to fill in the subsequent columns that belong to them all the way up and down the spreadsheet - BUT without seeing the overall spreadsheet that contains the other columns for the other staff members entering their data - is there a way perhaps to do this?
There are so many different ways to do this. Let me give you some ideas:
1. Filter the spreadsheet by name/user and send to that user (a lot of work if you have to do it for each user every time, also, users can un-filter and see info for other users)
2. Have a macro filter the spreadsheet for each user when they open the file. This could be based on Application.UserName, if that's the same name you have in the column, or have them login through UserForm or fill an InputBox with their name (which must be the same as the one in the column, so you could also have a drop-down with names - there is no security here, they could choose other user). For that you need a Workbook_Open event procedure to trigger the login, which hen filters the spreadsheet for that user. You would use a line of code similar of the one presented in this video to filter the data by the column with user name.
3. If you need security, you can adapt option 2 and add a login with password, saving login and password in a hidden sheet, for example. Additionally, you would unlock cells in visible rows for that user and protect the worksheet.
I hope that helps!
What if I want to add another criteria to filter these sheets? For eg, instead of only filtering by brand, I want to filter by brand and model?
Is this possible?
Just add another line to the code:
With ActiveSheet.Range("A1:C1")
.AutoFilter Field:=1, Criteria1:=brandName
.AutoFilter Field:=2, Criteria1:=modelName
End With
@@ExcelMacroMania i added it before the End if statement. It populates the same results. Where exactly should i place it
@@xdenvibthor6227 You should place it right after the first auto filter (for Field 1, your second is Field 2 because model is in column B or second column), then copy, add new sheet, paste, and show all data again. However, if you want now to split not just the brands, but also the models in different sheets, you will need to change the If statement for If Sheets(modelName) Is Nothing Then... and then later add the sheet with that name: Sheets.Add.Name = modelName. If you have let's say 3 brands (Toyota, Opel, Audi), but each of them have 2 different models, you end up with 6 new sheets for each model. Hope it works!
Not working
Hi Sir, I need your help, How do we get data from websites to excel using vba, according to set dates, thanks
That does not really have much to do with this video though. But I will add your request to my list and upload some about it soon.
@@ExcelMacroMania Thanks 👍
Hello Sir. I have long data in the Name column. Most of the cells include 40 to 50 characters. The cells with longer data are getting skipped. Is there is a way around that? Please help.
I think its the sheet name that has the limitation. Can you show me how to change the new sheets name to something smaller?
Sheets.add.name=name
Sheets(name).paste
How to change the name of the sheets to something else?
@@jm4giv Yes, there is a limit of course to the length of the sheet name, usually most limits are 255 characters, but the Excel sheet name is about 30 characters or so.
@@ExcelMacroManiaso how to use lang carecter text work sheet name can you let me. Know
@@shahzadalam4103 The maximum length is 31 characters and I don't think is possible to change that. But that's a reasonable size to show a good number of tabs. What you can do is to have an INDEX or CONTENTS tab at the beginning where you indicate how many tabs you have, what's the short name on the tab, and what's the long name or description for that tab. You can also add a link to the tabs as explained in this other video: ruclips.net/video/wZEXGZYQHfk/видео.html
Sir it helps a lot!! Thankss
But for my file I am not sure why I am unable to create all the sheets. The vba just stop after doing for specific Name.
My file contains Name with special symbol (i.e. /) will it affect the vba?
Sub CopyFilteredDataToNewSheets()
Dim r As Integer, Record_Label As String, ws As Worksheet
Set ws = ActiveSheet
ws.Range("A1:I1").AutoFilter
r = 1
Do
r = r + 1
Record_Label = ws.Range("G" & r).Value
On Error Resume Next
If Sheets(Record_Label) Is Nothing Then
ws.Range("A1:I1").AutoFilter Field:=7, Criteria1:=Record_Label
ws.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add.Name = Record_Label
Sheets(Record_Label).Paste
ws.ShowAllData
End If
Loop While ws.Range("G" & r + 1).Value ""
End Sub
Sir more info for you, my file has 378570 rows in total
You cannot use some special characters such as / \ ? * : [ ] and some other in the worksheet tab/name. That's why you get an error.
@@ExcelMacroMania thanks a lot. I tried to replace / by _ but still only half of the entries can create sheet with its data
Perhaps is there anything related to tow limit regarding to the vba?
As I do it separately it works so I wonder is there any row limit to the vba. Thanks a lot!
mine isnt coping the data from the other columns into the new worksheets...
Hmm.. any error? simply not copying? I think you are missing something. Please the code in the blog article here: excelmacroclass.blogspot.com/2020/07/copy-filtered-data-to-new-sheets.html
When i run this code i get extra blank sheets like sheet1,sheet2
That's probably because you are starting in row 1, so if you use the code in the video (a Do loop), make sure you add r=1 before the loop (that's actually added towards the end of the video and you may have missed it).
...
r = 1
Do
r = r + 1
brand = ws.Range("A" & r).Value
...
If you are using the code in the blog post (a For loop), the For should go from 2 To lastrow.
For r = 2 To lastrow
I used the same code as you have done r=1
But the problem is that when same brand name comes 2nd time its create an empty sheet with the sheet1 name
@@rahulsinghchauhan1464 When same brand name comes, the main IF statement avoids adding sheet and copy/paste values, that's this part of code - make sure is correct:
On Error Resume Next
If Sheets(brand) Is Nothing Then
...
If that's correct, the problem may be with the brand variable.- make sure it's declared as String, otherwise is a Variant and could take other form for example if there are numbers... Maybe there could be some characters in the brand name in column A that Excel does not recognize,... or maybe you have some trailing spaces in some cells, not sure, I cannot replicate your error. Try to change the Do loop for a For loop with exact numbers too and see (For r=1 to lastrow). Do you get as many sheets as rows? or, how many more empty sheets do you get? You can also use a modified version of the code that I explained in this other video, to get the list of unique entries first - ruclips.net/video/jyHcAOqkRZE/видео.html
genius but I like to copy only specific data no heading and only selected columns can you do it?
Change just this line as follows (as an example to copy columns A and C only): .Range("A:A,C:C").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy
@@ExcelMacroMania hi, this line of code is working very well, but do you have simpler code if let say we have A : V , and i only want to exclude D and E ? thank you
@@rendythamrin1663 So, if you mean to only copy columns D and E to new sheets for each unique value in column D (or in A as in the original video), you would just need to change this line of code:
.Columns("D:E").SpecialCells(xlCellTypeVisible).Copy
change also the brand if you want to filter on unique values in column D for example.
brand = Sheets("All").Range("D" & r).Value
No , i mean i only want to copy A:C and F: V , skipping D:E
@@rendythamrin1663 Then we go back to my initial response. You need to combine groups of cells (or columns or ranges if you will) using the semi-colon, and then use special cells.
.Range("A:C,F:V").SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy
instead of splitting the data and adding it to another sheet, could you show how to send the data as an attachments to multiple email address's depending which column relates to them? for example, columns a - z, row 1 (1 being header) to 100 and column C will have the supplier code which will be linked to the suppliers email address in another sheet
week, day ,supplier code, delviery date
1 2 as 12/12/12
2 3 as 12/12/12
3 4 bt 14/12/14
4 4 cd 25/06/13
I will add that to my list. I was planning to upload something about sending emails from excel so that should do.
@@ExcelMacroMania brilliant. hopefully you could do it soon because I'm really struggling to do it
What if I want to copy it to a new excel file? Kindly help
Use Workbooks.Add to create a new workbook and set it to a variable that you can use later. You probably need at least 2 variables, wb1 and wb2. Then refer each accordingly. Check this video for example: ruclips.net/video/9GgjoF7eJsg/видео.htmlsi=hT9QfVcFdiePXNd3
Also, you can probably check some videos of the workbook object to learn that well:
ruclips.net/video/rNqaL-JgBxU/видео.htmlsi=Pn0cWJ6FpGruXbjy
ruclips.net/video/oTzY44uou1Q/видео.htmlsi=bAk0D9ZPcoZyAQm1
How if is multiple creteria
To filter the data based on 2 criteria you can add Criteria2 along and Operator. For example, if you want to filter car sales for 2 brands you can do as follows:
Sheets("All").Range("A1:C1").AutoFilter Field:=1, Criteria1:=brandName1, Operator:=xlOr, Criteria2:=brandName2
Is it possible add new exel and run the code after that result in new excel
Sure it is, but you need to update the code to reference the workbook object - the first workbook with the data and the second "new" workbook with the filtered data. So you can do something like this:
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = ThisWorkbook
Workbooks.Add
Set wb2 = ActiveWorkbook
'filter and loop here , but reference wb1 and wb2 as needed - see example below:
For r = 1 To 20
With wb1.Sheets("All")
brandName = .Range("A" & r).Value
.Range("A1:C1").AutoFilter Field:=1, Criteria1:=brandName
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
End With
wb2.Sheets.Add.Name = brandName
wb2.ActiveSheet.Paste
Next
@@ExcelMacroMania Can you please provide full code
@@VIJAYBARASKAR9 That was the whole code you need, you just need to look at the previous macro and fill what is missing, don't be lazy 🙂 It should be something like this... but I didn't test it, so don't complain if it fails:
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = ThisWorkbook
Workbooks.Add
Set wb2 = ActiveWorkbook
With wb1.Worksheets("All")
.Range("A1:C1").AutoFilter
For r = 2 To 24
brandName = .Range("A" & r).Value
On Error Resume Next
If wb2.Sheets(brandName) Is Nothing Then
.Range("A1:C1").AutoFilter Field:=1, Criteria1:=brandName
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
wb2.Sheets.Add.Name = brandName
wb2.ActiveSheet.Paste
.ShowAllData
End If
Next r
End With
Hi, Thanks for the code, however, when I run the code, I get individual worksheets with no data.
code below.
Sub CopyFilteredData()
Dim r As Integer, agency As String, ws As Worksheet
Set ws = ActiveSheet
ws.Range("A1:BD1").AutoFilter
r = 1
Do
r = r + 1
agency = ws.Range("AS" & r).Value
On Error Resume Next
If Sheets(agency) Is Nothing Then
ws.Range("A1:BD1").AutoFilter Field:=1, Criteria1:=agency
ws.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add.Name = agency
Sheets(agency).Paste
ws.ShowAllData
End If
Loop While ws.Range("A" & r + 1).Value ""
End Sub
You need to change the "Field" of the autofilter. If you filter data for "agency" which is in column AS , right? then the Field is 45.
Please can you help me to cut it and paste it in another sheet instead of copying
You can just replace "Copy" with "Cut". For example:
Sheets(1).Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Cut
Sheets(brandName).Paste
But if you are going to cut everything from the main sheet, you can probably still do the "Copy" but then delete that main sheet at the end.
@@ExcelMacroMania thanks mine is a bit different my assignment is, I have been given a bunch of data with errors and one error is that in the branch of data there are blanks in a particular column( there are 4 columns in all) , so I'm to create a sub to filter those blanks in the column and cut and paste those blanks with their respective data in other columns in another sheet
I tried using yours that is replacing the copy with cut but there is an error which says " this can't be done on multiple range selection.
Please help me
@@opaddie Oh, for that check out this other video: Delete Blank Rows ruclips.net/video/sSoXeCmbP_A/видео.htmlsi=UiiaTsUJHdpbqP60
You need to combine the 2 macros and no need to filter I guess. Here's an example to cut rows with blanks in columns A:
totalRows = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
Sheets.Add 'if you don't have yet a second sheet
For r = 1 To totalRows
If Sheets(1).Range("A" & r).Value = "" Then
lr = Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Sheets(1).Rows(r).Cut Sheets(2).Rows(lr + 1)
End If
Next r
where Sheets(1) is the main sheet with data, and Sheets(2) is the other sheet where you paste the rows with blanks (in column A)
@@ExcelMacroMania please sheets (2).rows(ir + 1) gives me an error
It could give error because you don't have 2 sheets, ... or because the row to cut is empty - in case those rows are empty it makes no sense to copy or cut and paste, just delete. But if some rows have content and other don't ... then you probably need other macro, or just add "On Error Resume Next" at the beginning to skip the error.
Hi , unfortuantely didn't work for me using this routine:
Sub CopyFilteredDataToNewSheets()
Dim r As Integer, SUPERVISOR As String
With Worksheets("BILLS_2021")
.Range("A1:AD1").AutoFilter
For r = 2 To 22428
SUPERVISOR = Sheets("BILLS_2021").Range("I" & r).Value
On Error Resume Next
If Sheets(SUPERVISOR) Is Nothing Then
.Range("A1:AD1").AutoFilter Field:=1, Criteria1:=SUPERVISOR
.Range("I1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add.Name = SUPERVISOR
Sheets(SUPERVISOR).Paste
.ShowAllData
End If
Next r
End With
End Sub
There should have been a 20 sub sheets interms of supervisor.
I believe you should filter by SUPERVISOR in column I? That would be Field 9, not 1. Unless you also have the Supervisor in column A.
@@ExcelMacroMania .Range("A1:AD1").AutoFilter Field:=9, Criteria1:=SUPERVISOR ... THANKS , I did the required rectification, but no output ?
@@justengineer6276 Don't know where's the issue then. Check this other video and try to use some of those tools to debug your code: ruclips.net/video/Rg-gXg8MYKc/видео.html
@@justengineer6276 use criteria 9 instead of 1. Then check
Criteria 9= supervisor