Archie Goodwin

Предположим, вы записали с помощью макрорекордера макрос, который повторяет за вами проделанные операции, самый банальный например, копирование данных из одного экселевского файла в другой с указанием ячеек откуда копировать и куда копировать. Записали, воспользовались и забыли... ровно до следующего раза. А на следующий раз при выполнении макроса выскакивает ошибка, что мол нет открытого файла с таким именем.

Это происходит потому, что макрос записывает и название файла к которому происходит обращение и в случае, если вам нужно копировать однотипные данные из файлов, которые каждый раз называются по разному такие ошибки неизбежны.

Обойти выскакивание этих ошибок можно двумя путями:

1. Простой. Просто переименовать оба файла, с которыми производится работа, в тот вид, в котором они были когда записывался макрос. Например, записывался макрос в файле с названиваем "Остаток на 01.10.13.xls", работающий с файлом "Завоз на 01.10.13.xls". Вы скопировали файлы и обозвали их также, только изменили дату в названии на текущую.

То для того, чтобы воспользоваться макросом, новые файлы нужно обозвать точно также как и старые, ну, а старые, если они в той же папке, тоже нужно переименовать, добавив в названии к каждому что-либо. После выполнения макроса, названия можно вернуть к тому виду, в котором они были до этого.

Способ хоть и простой, но недостатком его есть постоянные манипуляции с именами и такой макрос оправдывает себя только тогда, когда он выполняет больше работы чем бы вы успели за то время, что возитесь с именами файлов.

Также этот способ крайне неудобен, если работая в одном экселевском файле вы запускаете несколько макросов, или тот же макрос но последовательно для нескольких книг по порядку, например, при консолидировании данных из нескольких отчетов в один.

2. С программированием в VBA. Потребуется дописать дополнительный код функции, которую будет использовать наш макрос и придется переписать все ссылки на файлы в макросе на переменные, которые будет использовать функция.

Непосредственно функция:

 
Function GetAnotherWorkbook() As Workbook
 ' если в данный момент открыто две книги, то функция возвратит вторую открытую книгу
 ' Если, помимо текущей, открыто более одной книги, то предоставляется выбор
 On Error Resume Next
 Dim coll As New Collection, WB As Workbook
 For Each WB In Workbooks
 If WB.Name <> ThisWorkbook.Name Then
 If Windows(WB.Name).Visible Then coll.Add CStr(WB.Name)
 End If
 Next WB
 Select Case coll.Count
 Case 0 ' нет других открытых книг
 MsgBox "Нет других открытых книг ", vbCritical, "Function GetAnotherWorkbook"
 Case 1 ' Открыта еще только одна книга, ее и возвращаем
 Set GetAnotherWorkbook = Workbooks(coll(1))
 Case Else ' открыто несколько книг, предоставляем выбор
 For i = 1 To coll.Count
 txt = txt & i & vbTab & coll(i) & vbNewLine
 Next i
 msg = "Выберите одну из следующих открытых книг и введите ее порядковый номер:" & _
 vbNewLine & vbNewLine & txt
 res = InputBox(msg, "Открыто более двух книг", 1)
 If IsNumeric(res) Then Set GetAnotherWorkbook = Workbooks(coll(Val(res)))
 End Select
End Function

Суть функции сводится к тому, что она определяет есть ли еще открытые книги, помимо той, из которой запускается макрос. Если таких книг оказывается только одна, то по умолчанию она и берется и ее имя задается через переменную, через которую мы можем обращаться к файлу. А если таких книг две и более, то всплывающее окно предоставит выбор - какой файл указать в качестве обращаемого.

Наш простой макрос "Вася" выглядит следующим образом:

Sub Вася()
 Windows("Продажи Васи.xlsx").Activate
 Range("B4").Select
 Selection.Copy
 Windows("Файл-манипулятор (с макросами).xlsm").Activate
 Range("B3").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Windows("Продажи Васи.xlsx ").Activate
 Range("B5").Select
 Application.CutCopyMode = False
 Selection.Copy
 Windows("Файл-манипулятор (с макросами).xlsm ").Activate
 Range("C3").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Windows("Продажи Васи.xlsx ").Activate
 Range("B6").Select
 Application.CutCopyMode = False
 Selection.Copy
 Windows("Файл-манипулятор (с макросами).xlsm ").Activate
 Range("D3").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
End Sub

И для того чтобы заработала наша универсальная функция нужно немного переписать код, в первую очередь, заменив имена файлов на переменные используемые в функции.

Sub CopyВася()
On Error GoTo Errors1
 Dim WS1 As Excel.Worksheet
 Dim WB As Workbook
 Set WS1 = ActiveWorkbook.ActiveSheet
 Set WB = GetAnotherWorkbook
 
 If Not WB Is Nothing Then
 MsgBox "Выбрана книга: " & WB.FullName, vbInformation
 Else
 MsgBox "Книга не выбрана", vbCritical: Exit Sub
 End If
'------Start
 WB.ActiveSheet.Range("B4").Copy
 WS1.Range("B3").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 
 WB.ActiveSheet.Range("B5").Copy
 WS1.Range("C3").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 
 WB.ActiveSheet.Range("B6").Copy
 WS1.Range("D3").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 
'------End
 
Errors1:
If Err.Number <> 0 Then
MsgBox "Ошибка № " & Err.Number & ". Что-то не так :)"
End If

End Sub

Пример можно скачать ниже.