[英]How to copy sheets with certain tab color from one workbook to another?
I have several Workbooks where there are several sheets that have Tab color with RGB code (0,255,0) ie completely green so I need to copy only these sheets to ActiveWorkbook without opening workbooks containing these green sheets我有几个工作簿,其中有几张工作表具有带有 RGB 代码 (0,255,0) 的 Tab 颜色,即完全绿色,因此我只需要将这些工作表复制到 ActiveWorkbook,而无需打开包含这些绿色工作表的工作簿
Sub Copy_Green_Sheets()
Dim wb As Workbook
Dim ws As Worksheet
If ws.Tab.Color = RGB(0, 255, 0) Then
Set wb = Workbooks("Target workbook")
For Each ws In Workbooks("source workbook").Worksheets
ws.Copy After:=wb.Sheets(wb.Sheets.Count)
Next ws
End If
End Sub
Option Explicit
Sub DoItForAllWorkbooks()
Dim myWorkbook As Workbook
Dim myWbFullNames(100) As String
Dim iCt As Integer
' You might to want to create such a list with Excel:
'="' myWbFullNames("&B3&") = ""C:\mySpecialFolder\myFile0"&B3&".xlsx"""
myWbFullNames(1) = "C:\mySpecialFolder\myFile01.xls"
myWbFullNames(2) = "C:\mySpecialFolder\myFile02.xls"
myWbFullNames(3) = "C:\mySpecialFolder\myFile03.xls"
myWbFullNames(4) = "C:\mySpecialFolder\TabColor4.xlsx"
myWbFullNames(5) = "C:\mySpecialFolder\myFile05.xls"
For iCt = 1 To 5
Workbooks.Open myWbFullNames(iCt)
Set myWorkbook = ActiveWorkbook
Call Copy_Green_Sheets_NEW(ActiveWorkbook)
myWorkbook.Close
Next iCt
End Sub
Sub Copy_Green_Sheets_NEW(SourceWorkbook as workbook)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks("Target workbook")
'For Each ws In Workbooks("source workbook").Worksheets --- OLD
For Each ws In SourceWorkbook.Worksheets
If ws.Tab.Color = RGB(0, 255, 0) Then
ws.Copy After:=wb.Sheets(wb.Sheets.Count)
End If
Next ws
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.