Я надеюсь, что есть способ решить один из очень трудоемких процессов, которые я сейчас выполняю вручную.
Я собираю информацию от более чем 30 человек, которые присылают мне свои достижения (в формате xlsx). До сих пор я открывал каждый файл, находил листы, названные определенным образом (например, искал листы, в названии которых было слово "План"), копировал найденные листы в совершенно новую книгу и сохранял вновь созданную книгу в указанном месте.
Можно ли автоматизировать этот процесс с помощью макроса? В идеале мне нужен макрос, который копирует листы, содержащие "план" в названии листа и не открывая несколько рабочих книг, копирует выбранные рабочие листы, найденные во всех файлах, сохраненных в одной папке, и вставляет эти листы в совершенно новую рабочую книгу. Можно ли этого достичь?
У меня есть код ниже, но когда я запускаю этот макрос, ничего не происходит. Вы видите, что является причиной проблемы?
Sub CopyWorkSheets(strDirectory As String, strSheetName As String)
Dim xlThisWB As Workbook
Dim xlWB As Workbook
Dim xlWS As Worksheet
Dim strFileName As String
Dim iCount As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set xlThisWB = ThisWorkbook
strFileName = Dir(strDirectory & "*.xlsx")
Do While strFileName <> ""
If strFileName <> xlThisWB.Name Then
With xlThisWB
Set xlWB = Workbooks.Open(Filename:=strDirectory & strFileName)
Set xlWS = xlWB.Worksheets(strSheetName)
xlWS.Copy after:=xlThisWB.Worksheets(xlThisWB.Worksheets.Count)
xlWB.Close
End With
End If
strFileName = Dir()
Loop
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub