繁体   English   中英

如何将具有特定标签颜色的工作表从一个工作簿复制到另一个工作簿?

[英]How to copy sheets with certain tab color from one workbook to another?

我有几个工作簿,其中有几张工作表具有带有 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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM