Усовершенствование кода

[Ogeris]

Добрый день!

Необходимо перенести данные из 18 книг в одну (диапазон данных в столбцах A:AU). Ниже я привожу код, с помощью которого я это делаю (книга, в которую переносятся данные, называется "План-график", из которых переносятся, называются по номерам от 01 до 18го.):

Windows("01.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("кб59").Select
Range("A1").Select
ActiveSheet.Paste

Windows("02.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("кп54").Select
Range("A1").Select
ActiveSheet.Paste

Windows("03.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("л60").Select
Range("A1").Select
ActiveSheet.Paste

Windows("04.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("кар21").Select
Range("A1").Select
ActiveSheet.Paste

Windows("05.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("л65").Select
Range("A1").Select
ActiveSheet.Paste

Windows("06.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("р13").Select
Range("A1").Select
ActiveSheet.Paste

Windows("07.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("л60_2").Select
Range("A1").Select
ActiveSheet.Paste

Windows("08.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("пр52").Select
Range("A1").Select
ActiveSheet.Paste

Windows("09.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("у9").Select
Range("A1").Select
ActiveSheet.Paste

Windows("10.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("гф6").Select
Range("A1").Select
ActiveSheet.Paste

Windows("11.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("кб85").Select
Range("A1").Select
ActiveSheet.Paste

Windows("12.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("кр41").Select
Range("A1").Select
ActiveSheet.Paste

Windows("13.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("о14").Select
Range("A1").Select
ActiveSheet.Paste

Windows("14.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("гз12").Select
Range("A1").Select
ActiveSheet.Paste

Windows("15.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("лыс").Select
Range("A1").Select
ActiveSheet.Paste

Windows("16.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("чк").Select
Range("A1").Select
ActiveSheet.Paste

Windows("17.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("Ш112").Select
Range("A1").Select
ActiveSheet.Paste

Windows("18.xls").Activate
Sheets(1).Activate
Columns("A:AU").Select
Selection.Copy
Windows("План-График.xls").Activate
Sheets("мира").Select
Range("A1").Select
ActiveSheet.Paste

Вопрос первый: можно ли сделать проверку, если не открыта книга "03", то пропускать действие и переходить к следующей?

Вопрос второй: Возможно, у Вас будут идеи, как усовершенствовать данный процесс, или организовать его совсем по-другому

[doober]

Попробуйте так

Sub Go_Junior 
Dim Sh As Worksheet, WB0 As Workbook, Sh0 As Worksheet
Dim X As Variant, LastRow As Long
Set WB0 = Workbooks("План-График.xls")
For Each W In Application.Windows
Set Sh = Workbooks(W.Caption).Worksheets(1)
LastRow = Sh.Range("A1").End(xlDown).Row
X = Sh.Range("A1:AU" & LastRow)
Select Case W.Caption
Case "01.xls"
Set Sh0 = WB0.Worksheets("кб59")
Sh0.Range("A1").Resize(UBound(X, 1), UBound(X, 2)) = X
Case "02.xls"
Set Sh0 = WB0.Worksheets("кп54")
Sh0.Range("A1").Resize(UBound(X, 1), UBound(X, 2)) = X
'Case "Остальные файлы" 'Аналогично для остальных файлов

End Select

Next

End Sub

[alex77755]

И что, все 18 книг в это время должны быть открыты?
Или именно на этом основан принцип отбора?
Если необходимо выбрать из всех книг, то, как по мне, проще создать список-массив имён листов, а потом просто в цикле открывать и переносить данные на нужный лист.
Типа

Dim ЛИСТЫ()
ЛИСТЫ= Array("кб59","кп54","л60".....)
For J  = 1 to 18
 Workbooks.Open Filename:="C:\....\" & J & ".xls", Origin:=xlWindows
'''''''''''''''''''''''''
Sheets(ЛИСТЫ(J - 1)).Select
'''''''
next J