Skip to main content

В один файл скопировать все закладки из выбранных файлов эксель

Sub CombineWorkbooks()
Dim FilesToOpen
Dim x, maincount As Integer

'Application.ScreenUpdating = False 'îòêëþ÷àåì îáíîâëåíèå ýêðàíà äëÿ ñêîðîñòè

'âûçîâåì äèàëîã ôàéëà äëÿ âûáîðà
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="All files (*.*), *.*", _
MultiSelect:=True, Title:="Files to Merge")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "íå âûáðàíî íèîäíîãî ôàéëà!"
Exit Sub
End If

'ïðîõîäèì ïî âûáðàííûì ôàéëààì
x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        importWB.Close savechanges:=False
        x = x + 1
    Wend
 
    Application.ScreenUpdating = True
End Sub