Доброго времени суток всем!
Прошу помочь с решением очередной задачки по VBA.
Ранее был написан макрос для раскидывания листов excel по создаваемым файлам. Все было замечательно до тех пор, пока не возникла необходимость переименовывать листы в создаваемых файлах. В исходном файле изменять наименования листов нельзя.
На листе "Mapping" исходного файла представлены две таблицы:
- левая содержит соответствие старых и новых имен листов,
- правая - содержит перечень листов, которые должны переноситься в определенные файлы.
Пробовал решить задачу путем добавления нового цикла For...Next в уже существующий, но столкнулся с тем, что справочник находится в исходном файле, а листы которые надо переименовать - в другом. Как правильно обратиться к вновь создаваемым файлам найти у меня не получилось.
ниже привожу код VBA:
Добавив второй цикл, я ничего не добился, только макрос прекращает свое действие, а файл закрывается.
Прошу подсказать, как можно обращаться к разным файлам в данном случае.
Заранее спасибо всем откликнувшимся!
P.S. файл с примером в приложении
Прошу помочь с решением очередной задачки по VBA.
Ранее был написан макрос для раскидывания листов excel по создаваемым файлам. Все было замечательно до тех пор, пока не возникла необходимость переименовывать листы в создаваемых файлах. В исходном файле изменять наименования листов нельзя.
На листе "Mapping" исходного файла представлены две таблицы:
- левая содержит соответствие старых и новых имен листов,
- правая - содержит перечень листов, которые должны переноситься в определенные файлы.
Пробовал решить задачу путем добавления нового цикла For...Next в уже существующий, но столкнулся с тем, что справочник находится в исходном файле, а листы которые надо переименовать - в другом. Как правильно обратиться к вновь создаваемым файлам найти у меня не получилось.
ниже привожу код VBA:
| Код |
|---|
Sub test_1()
Dim ws As Worksheet
Dim Filename
Dim NewFileName As String
Dim i&
Dim j&
Dim lLastRow_1 As Long
Dim lLastRow_2 As Long
Dim cell As Range
On Error Resume Next
lLastRow_1 = Sheets("Mapping").Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To lLastRow_1
Set Filename = ThisWorkbook.Sheets("Mapping").Cells(i, 4)
NewFileName = ThisWorkbook.Path & "\" & Filename & _
".xlsx"
ThisWorkbook.Sheets(Split(ThisWorkbook.Sheets("Mapping").Cells(i, 5))).Move
lLastRow_2 = Sheets("Mapping").Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To lLastRow_2
Set cell = Sheets("Mapping").Cells(i, 2)
Set ws = Worksheets
ActiveWorkbook.ws.Name = CStr(cell.Value)
Next
ActiveWorkbook.SaveAs Filename:=NewFileName
ActiveWorkbook.Close SaveChanges:=False
Next
End Sub
|
Добавив второй цикл, я ничего не добился, только макрос прекращает свое действие, а файл закрывается.
Прошу подсказать, как можно обращаться к разным файлам в данном случае.
Заранее спасибо всем откликнувшимся!
P.S. файл с примером в приложении
