Копировать вкладки с аналогичным частичным именем в другую книгу

Question

Буду признателен, если есть какая-либо помощь. Допустим, у меня есть следующие вкладки: Data Set 001, Data Set 002, Data Set 003, поэтому, если имена вкладок содержат Набор данных , его следует скопировать в другую книгу (скажем, Main File) , Любая помощь в этом отношении приветствуется. Спасибо всем заранее!

С наилучшими пожеланиями, Джо sh

Answer 1

Вам необходимо l oop пройти через все рабочие листы вашей первой рабочей книги, проверить, содержит ли ее имя Набор данных с Worksheet.Name и InStr .

Если функция InStr возвращает что-то, отличное от 0 (то есть имя вашего рабочего листа содержит Набор данных ), вы можете скопировать текущий рабочий лист во 2-ю рабочую книгу.

Адаптируйте этот образец к вашим потребностям:

'Loop through all worksheets

If InStr(wsCurrent.Name,"Data Set") <> 0 Then
    ' Copy wsCurrent to new WorkBook
End If

' End of loop

Answer 2

Я использовал это в рабочей книге, содержащей рабочий лист «ASSESSMENT FORMxx»:

Sub CopyWorksheetsToNewWorkbook()

'This macro is to be in the ActiveWorkbook

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim wb As Workbook
Dim ws As Worksheet

Set wb = Workbooks.Add
wb.SaveAs Filename:="Book10" & ".xlsx"
Workbooks.Open ("Book10.xlsx")

For Each ws In Workbooks("ActiveWorkbookName.xlsm").Sheets
If ws.Name Like ("ASSESSMENT FORM*") Then ws.Copy Before:=Workbooks("Book10.xlsx").Worksheets("Sheet1")
Next ws

Workbooks("Book10.xlsx").Worksheets("Sheet1").Move Before:=Workbooks("Book10.xlsx").Sheets(1)

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Обратите внимание, что должны быть открыты и рабочая книга с рабочим листом «ASSESSMENT FORMxx», и Book10.xlsx.

Answer 3

Был ли у вас go в любом коде?

Sub Whatever()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks("AnyOpenWorkbookName.xlsx")
For Each ws In ThisWorkbook.Sheets
    If ws.Name Like "Data Set" & "*" Then
        Call ws.Copy(after:=wb.Sheets(wb.Sheets.Count))
    End If
Next ws
End Sub