Log In
Register
Home
Active Member
June 4, 2021
Offline
Hello everyone,
I am a beginner, can you please help me to write a code in VBA to copy excel sheets with the same colour tab to new files and save it?
Thanks for your help.
Power Query
Power Pivot
Xtreme Pivot Tables
Excel for Decision Making
Excel for Finance
Excel Analysis Toolpak
Power BI
Excel
Word
Outlook
Excel Expert
Excel Customer Service
PowerPoint
November 8, 2013
Offline
Hi Vee Dee,
Try this code:
Sub CopySheetsByColor()
Dim SheetColors As Object, Wks As Worksheet, Arr() As Variant, Counter As Long, DictKey As Variant
Dim ShColor As String, NewWb As Workbook
Set SheetColors = CreateObject("scripting.dictionary")
For Each Wks In ThisWorkbook.Worksheets
ShColor = Wks.Tab.Color
If SheetColors.Exists(ShColor) Then
Arr = SheetColors(ShColor)
Counter = UBound(Arr) + 1
Else
Counter = 0
End If
ReDim Preserve Arr(0 To Counter)
Arr(Counter) = Wks.Name
SheetColors(ShColor) = Arr
Next Wks
For Each DictKey In SheetColors.Keys
Set NewWb = Workbooks.Add
ThisWorkbook.Worksheets(SheetColors(DictKey)).Copy Before:=NewWb.Worksheets(1)
NewWb.SaveAs ThisWorkbook.Path & Application.PathSeparator & DictKey & Format(Now, "yyyy-mm-dd hh-mm-ss") & ".xlsx"
NewWb.Close
Next
End Sub
Active Member
June 4, 2021
Offline
Hi Catalin Bombea,
Thank you for your effort. I am sorry I probably didn´t describe the issue properly. The case is that I would like to extract/copy sheets with the same tab color from the original file and save the copies of the particular sheets to a separate files. So, if in an original file would be 100 sheets in total, with used 20 tab colors than the macro should generate 20 separate files each consisting specific tab color sheets. (Let us say, I have customers and each has its own tab color in the file. Then I need to send the separtated files (consisting sheets with the same tab color) dedicated to specific customers.)
Thank you very much for your help.
Power Query
Power Pivot
Xtreme Pivot Tables
Excel for Decision Making
Excel for Finance
Excel Analysis Toolpak
Power BI
Excel
Word
Outlook
Excel Expert
Excel Customer Service
PowerPoint
November 8, 2013
Offline
Sub CopySheetsByColor()
Dim Wks As Worksheet, NewWb as Workbook
For Each Wks In ThisWorkbook.Worksheets
If not Wks.Tab.Color=False then
Set NewWb = Workbooks.Add
wks.Copy Before:=NewWb.Worksheets(1)
NewWb.SaveAs ThisWorkbook.Path & Application.PathSeparator & wks.Name & Format(Now, "yyyy-mm-dd hh-mm-ss") & ".xlsx"
NewWb.Close
End If
Next
End Sub
Active Member
June 4, 2021
Offline
Hi Catalin,
It is great how you want to help me. Due to this, I feel very uncofortable to write that it isn´t still what I wanted. I would like to have the same tab color sheets gethered in one file. As an example: I have customers each has its own tab color but but once I have 5 sheets of the same tab color for one client and I need to separate and save all the sheets of the same tab color to one file and send it to him, then another client can have 3 sheets of the same tab color.... it varies from month to month and from client to client....
Thank you very much!!!
Power Query
Power Pivot
Xtreme Pivot Tables
Excel for Decision Making
Excel for Finance
Excel Analysis Toolpak
Power BI
Excel
Word
Outlook
Excel Expert
Excel Customer Service
PowerPoint
November 8, 2013
Offline
I would like to have the same tab color sheets gethered in one file.
Then what's wrong in the initial code that I sent you? That is EXACTLY what the first code sent does, it groups the same color sheets into the same file.
Active Member
June 4, 2021
Offline
I may do something wrong but testing the fist macro, it generates 2 output files: one with all tabs that were colored (mixes all colors) + the one with the sheet that hasn´t been tab colored.
Power Query
Power Pivot
Xtreme Pivot Tables
Excel for Decision Making
Excel for Finance
Excel Analysis Toolpak
Power BI
Excel
Word
Outlook
Excel Expert
Excel Customer Service
PowerPoint
November 8, 2013
Offline
Try replacing:
ShColor = Wks.Tab.ThemeColor & Wks.Tab.TintAndShade
with:
ShColor = Wks.Tab.Color
1 Guest(s)
