Я вижу, что вы новичок в VBA, и есть некоторые концепции, которые вы быстро понимаете. Запись макросов в Excel - отличный способ узнать, как можно что-то сделать в Excel. Однако у Excel также есть некоторые недостатки. Вот несколько понятий, которые помогут:
Не использовать Выбор , ActiveCell , ActiveSheet , Выбрать , Активируйте и т. Д., Если вам абсолютно не нужно. Я знаю, что это именно то, что делает Macro Recorder в Excel, но если вы сделаете это неправильно, это может привести к ошибкам, особенно когда вы начинаете работать с несколькими книгами!
Намного лучше назначить объект и использовать этот объект, чтобы делать то, что вы хотите. В приведенном ниже коде я назначил Рабочие книги и рабочие таблицы объектам и использовал их для выполнения работы. Диапазоны также являются общими объектами для использования.
В связи с этим, всегда полностью квалифицируйте ваши объекты . Например, вы можете написать код, подобный следующему: Var1 = Cells(1, 1).Value
, но он будет получать значение из ячейки A1 в Active Worksheet , а не обязательно в том листе или книге, которые вы намеревались. Намного лучше написать это так: Var1 = wksSource.Cells(1, 1).Value
Я указал имя листа "Лист1" для вашей исходной рабочей книги - замените его на фактическое имя листа, который вы копируете из .
Я назначил наиболее распространенные строки для Константы вверху. Существует баланс между назначением каждой строки константе и использованием только строковых строк (например, некоторые могут назначать имена листов, например, «LISTS», константе), но если они используются только один раз и на видном месте, Я не волнуюсь о назначении константы для этого. Но особенно когда значение используется в нескольких местах, константа облегчает, когда вы хотите повторно использовать код для аналогичной задачи. Я также добавил туда константу для исходного пути, хотя это не требуется, если рабочая книга уже открыта.
Я также объявил все переменные вверху - некоторые языки и программисты делают это по-разному, но мне нравится видеть, что используется в начале.
Обратите внимание на спецификатор While на вашем Do ... Loop . Это будет выполнено только в том случае, если в первом столбце текущей строки есть значение.
Вот как бы я написал код для вашей задачи:
Sub Macro3()
Dim SourceRow As Long
Dim DestRow As Long
Dim Path As String
Dim FileName1 As String
Dim FileName2 As String
Dim FullFileName As String
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim wkbDest As Workbook
Dim wksDest As Worksheet
Dim wksDest2 As Worksheet
Const scWkbSourcePath As String = "D:\folder1\folder2\Projects\" ' For example
Const scWkbSourceName As String = "theFILE2.working.xlsm"
Const scWkbDest1Path As String = "D:\folder1\folder2\Projects\The_FILES\New_folder\"
Const scWkbDest1Name As String = "OVERVIEW TEMPLATE_macro edition_current_.xlsm"
Const scWkbDest2Path As String = "D:\folder1\folder2\Projects\The_FILES\theFILES\"
Set wkbSource = Workbooks(scWkbSourceName)
Set wksSource = wkbSource.Sheets("Sheet1") ' Replace Sheet1 with the sheet name
SourceRow = 5
DestRow = 4
Do While wksSource.Cells(SourceRow, 1).Value <> ""
' Open the template workbook
Set wkbDest = Workbooks.Open(scWkbSourcePath & scWkbDest1Name)
Set wksDest = wkbDest.Sheets("LISTS")
''COPY A ROW
wksSource.Rows(SourceRow).Copy Destination:=wksDest.Rows(DestRow)
Application.CutCopyMode = False
With wksDest.Rows(DestRow).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
wkbDest.Activate
Set wksDest2 = wkbDest.Sheets("PLANT OVERVIEW")
''SAVE AS
FileName1 = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
Replace(wksDest2.Range("N1").Value _
, ".", "_") _
, "/", "_") _
, "\", "_") _
, "?", "_") _
, "|", "_") _
, "<", "_") _
, ">", "_") _
, ":", "_") _
, "*", "_") _
, """", "_")
FileName2 = wksDest2.Range("A1").Value
Path = scWkbDest2Path & FileName1 & "\"
If Len(Dir(Path, vbDirectory)) = 0 Then
MkDir Path
End If
FullFileName = Path & FileName2 & ".xlsx"
wkbDest.SaveAs Filename:=FullFileName, FileFormat:=xlOpenXMLWorkbook
wkbDest.Close
' Best practice to set objects to Nothing before re-using an object variable
Set wksDest = Nothing
Set wksDest2 = Nothing
Set wkbDest = Nothing
' Move down 1 row for source sheet
SourceRow = SourceRow + 1
Loop
End Sub
Редактировать
Некоторые заметки и вещи, которые я узнал относительно символов имени папки и файла:
- Хотя в именах файлов можно использовать скобки * , я не смог сохранить исходное имя файла для сохранения, но удаление скобок решило проблему.
- Поскольку вы создаете имена файлов и папок из (потенциально грязных) данных, вы должны очистить (удалить или заменить на _ ) символы, которые нельзя использовать в этих именах: \ / | ? <</strong> > : * "
- Я нашел это на странице Microsoft для Именования файлов, путей и пространств имен :
Не заканчивайте имя файла или каталога пробелом или точкой.
Хотя это разрешено внутри имени файла, точка остановки (. ) не может быть последним символом имени папки, как правило, там, где вы найдете его в текстовой строке. Кроме того, это может сбивать с толку и иногда вызывать проблемы в имени файла, поэтому я рекомендую заменить их все.
- Функция Trim () может использоваться для удаления пробелов в конце имени папки . Имейте в виду, что внутри строки он также заменяет несколько пробелов в строке на один пробел.
Тем более что вы создаете папки из данных, вы должны убедиться, что папка существует, прежде чем сохранять в нее файл. MkDir - команда для этого.
- Если ваша рабочая книга шаблона не открыта при запуске, вам может потребоваться указать путь и в операторе Open ().