將數據從多個工作表復制到新工作簿中的多個工作表中

Question

我知道有人問過這個問題的變體，但我似乎找不到正確的代碼來完成這個任務。 我有 2 個選項卡，主摘要和主詳細信息，我想分別根據 K 列和 G 列中的單元格值從中復制數據。 如果這些列的值匹配，我想將兩個選項卡中的數據復制到新工作簿中。 每個值都需要自己的工作簿作為名稱保存在單元格中。

謝謝

Answer 1

這是我想出的：

子 CopyCMOsToOwnWorkbooks()

Application.EnableCancelKey = xlDisabled Application.ScreenUpdating = False

將 CMO 變暗為變體 將 CMOS 變暗為變體 將 wbDest 變暗為工作簿 將 RAF 變暗為工作簿 Set RAF = ThisWorkbook Dim rng As Range Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))

CMOS = Array("Element Care", "CCACG EAST", "SCMO", "CCACG WEST", "Uphams Corner Hlth Cent", "CCC-Boston", "Vinfen", "Behavioral Hlth Ntwrk", _ "CommH Link Worc”、“長期護理 CMO”、“Advocates, Inc”、“CCC-Springfield”、“BU Geriatric Service”、“Lynn Comm HC”、“CCA-BHI”、“BIDJP Subacute”、_“CCC-勞倫斯” ", "CCC-Framingham", "East Boston Neighborhoo", "BosHC 4 Homeless", "Bay Cove Hmn Srvces", "Mailhoit, Carrie", "Brightwood Hlth Ctr-Bay", _ "Romero, Michele", "Isaacs , Cindy”、“McCoy, Viola”、“大北岸 ADRC”、“Geller, Marian”）

For Each CMO In CMOS

On Error Resume Next

RAF.Activate
Application.CutCopyMode = False
Sheets("MASTER Summary").Select
Range("F12").Select
Selection.AutoFilter
ActiveSheet.ListObjects("Table_Query_from_ProdServerP052").Range.AutoFilter _
    Field:=11, Criteria1:=CMO
Cells.Select
Selection.Copy
Set wbDest = Workbooks.Add(xlWBATWorksheet)
ActiveSheet.Paste
ActiveSheet.Cells.Select
Selection.ColumnWidth = 8.29
Cells.EntireColumn.AutoFit
Selection.ColumnWidth = 78.71
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Summary"
Range("C24").Select
ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = _
    "Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight13"
RAF.Activate
Application.CutCopyMode = False
Sheets("MASTER Detail").Select
Range("A2").Select
Selection.AutoFilter
ActiveSheet.ListObjects("Table_Query_from_ProdServerP054").Range.AutoFilter _
    Field:=7, Criteria1:=CMO
Cells.Select
Selection.Copy
wbDest.Activate
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Cells.Select
Selection.ColumnWidth = 34.29
Selection.ColumnWidth = 50.71
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
wbDest.Sheets("Sheet2").Select
wbDest.Sheets("Sheet2").Name = "Detail"
ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = _
          "Table2"
Range("Table2[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight13"
Range("A13").Select
wbDest.Sheets("Summary").Select
Application.DisplayAlerts = False
wbDest.SaveAs ThisWorkbook.Path & Application.PathSeparator & _
CMO & " " & Format(Date, "mmm_dd_yyyy")
Application.DisplayAlerts = True
wbDest.Close
Next CMO

結束子