将多个工作表中的数据复制到新工作簿中的多个工作表中

Question

我知道有人问过这个问题的变体，但我似乎找不到合适的代码来完成这项任务。我有 2 个选项卡，主摘要和主详细信息，我想分别根据列 K 和 G 中的单元格值复制数据。如果这些列的值匹配，我想将两个选项卡中的数据复制到新工作簿中。每个值都需要将其自己的工作簿保存为单元格中的名称。

谢谢

Answer 1

这是我想出的：

Sub CopyCMOsToOwnWorkbooks()

Application.EnableCancelKey = xlDisabled Application.ScreenUpdating = False

将 CMO 调暗为变体 调暗 CMOS 作为变体 将 wbDest 调暗为工作簿 将 RAF 调暗为工作簿 设置 RAF = ThisWorkbook 调暗为范围 设置 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”、“Long Term Care CMO”、“Advocates, Inc”、“CCC-Springfield”、“BU Geriatric Service”、“Lynn Comm HC”、“CCA-BHI”、“BIDJP Subacute”、_ “CCC-Lawrence”、“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

结束子