Копирование данных с нескольких листов на несколько листов в новой книге

Question

Я знаю, что варианты этого вопроса заданы, но я не могу найти правильный код для выполнения этой задачи. У меня есть 2 вкладки, Основная сводка и Мастер-данные, из которых я хотел бы скопировать данные на основе значений ячеек в столбцах K и G соответственно. Я хотел бы скопировать данные с обеих вкладок в новую книгу, если значения, которые соответствуют этим столбцам. Каждое значение требует, чтобы его собственная книга сохранялась как имя в ячейке.

Благодаря

Answer 1

Вот что я придумал:

Sub CopyCMOsToOwnWorkbooks()

Application.EnableCancelKey = xlDisabled Application.ScreenUpdating = False

Dim ОКУ как вариант Dim CMOS как вариант Dim wbDest As Workbook Dim RAF As Workbook Комплект RAF = ThisWorkbook Dim ГСЧ Как Range Set ГСЧ = Диапазон (Range ("A1"), Range ("A1"). SpecialCells (xlLastCell))

CMOS = Array ("Element Care", "CCACG ВОСТОК", " 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 », , «Босфор 4 бездомный», «Бэй-Коув Хмн Срвсес», «Майлхоит, Кэрри», «Ярвуд-Хат Стри-Бэй», _ «Ромеро, Микеле», «Исаак, Синди», «Маккой, альта», «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 

End Sub