複数のシートのデータを新しいワークブックの複数のシートにコピー

Question

この質問のバリエーションが尋ねられましたが、私はこのタスクを達成するための正しいコードを見つけることができません。 Master SummaryとMaster Detailの2つのタブがあります。そこから、それぞれKとGの列のセル値に基づいてデータをコピーしたいと思います。これらの列が一致する値がある場合、両方のタブから新しいブックにデータをコピーしたいと思います。各値にはセル内の名前として保存する独自のワークブックが必要です。ここで

おかげ

Answer 1

は私が思い付いたものです：

サブCopyCMOsToOwnWorkbooks（）バリアント 点心として

Application.EnableCancelKey = xlDisabled Application.ScreenUpdating = Falseの

薄暗いCMO CMOS as Variant ワークブックとしてdim wbDest Dim RAF Asワークブック RAF =レンジ セットRNGとしてはThisWorkbook 薄暗いRNG =レンジ（範囲（ "A1"）、レンジ（ "A1"）。SpecialCells（xlLastCell））

CMOS =配列（ "要素のケア"、 "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-ローレンス」、「CCC-Framingham」、「East Boston Neighborhoo」、「CCC-Springfield」、「BU Geriatric Service」、「Lynn Comm HC」、「CCA-BHI」、「BIDJP Subacute」、 、 "BosHC 4ホームレス"、 "ベイコーブHmn Srvces"、 "Mailhoit、キャリー"、 "Brightwood Hlth Ctr-Bay"、_ "Romero、Michele"、 "Isaacs、Cindy"、 "McCoy、Viola"、 "ADRCグレーターノースショア "、"ゲラー、マリアン "）

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 

エンドサブ