Question

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

由于

Answer 1

以下是我提出的建议：

Sub CopyCMOsToOwnWorkbooks（）

Application.EnableCancelKey = xlDisabled Application.ScreenUpdating = False

Dim CMO As Variant Dim CMOS As Variant 昏暗的wbDest作为工作簿昏暗的RAF作为工作簿设置RAF = ThisWorkbook Dim rng As Range 设置rng =范围（范围（“A1”），范围（“A1”）。SpecialCells（xlLastCell））

CMOS =阵列（“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老年医学服务”，“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

End Sub

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

1 个答案: