Я не очень хорошо объяснил с первого раза. То, что я пытаюсь сделать, это взять рабочую книгу, вытащить бюджетный центр из набора листов как BCD, вставить этот бюджетный центр в ячейку на листе, установленную как IGE, чтобы макрос выполнял кучу задач (включая оценку множества ячейки), сохраните файл как номер бюджетного центра, затем возьмите следующий номер бюджетного центра, скопируйте и вставьте его и выполните те же задачи, включая сохранение файла в качестве имени бюджетного центра и повторяйте его, пока не будет достигнут последний бюджетный центр. Я могу заставить все работать отлично для первого бюджетного центра, но затем макрос останавливается после сохранения первого файла. Я могу снова открыть шаблон, но макрос думает, что он закончен. Я надеюсь, что это более понятно. И спасибо.
Sub RunMacro()
Dim OpenPath As String
Dim OpenName As String
Dim BCD As Worksheet
Dim IGE As Worksheet
Dim LAE As Worksheet
Dim x As Integer
Dim y As Integer
Dim r As Integer
Dim c As Integer
Dim lr As Integer
Dim lc As Integer
Dim SavePath As String
Dim FileName As String
Dim LastRow As Long
OpenPath = "\\filer01\financedrv\budget\" & Year(Date) + 1 & " Budget\" 'Sets the save path for the file
OpenName = "Budget Center Template 2019.xltm"
Set BCD = Worksheets("Budget Center Data")
Set IGE = Worksheets("input gen'l exp")
Set LAE = Worksheets("input lae")
BCD.Activate
LastRow = BCD.Range("A1").End(xlDown).Row
Do While LastRow <> 0
For y = 1 To 1
For x = 2 To 200 Step 1
If BCD.Cells(x, y).Value <> "" Then
BCD.Cells(x, y).copy
IGE.Range("B4").PasteSpecial xlPasteValues
End If
IGE.Activate
For c = 3 To 3 'Sets the column to the third column (C)
For r = 11 To 1500 Step 1
If Cells(r, c).Value <> Year(Date) + 1 Then
Cells(r, c).Offset(0, 2).Select
Range(Selection, Selection.End(xlToRight).Offset(, -1)).copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.Locked = True
Cells(r + 1, c).Activate
End If
Next r
Next c
Range("B4:B6").copy
Range("B4:B6").PasteSpecial xlPasteValues
Range("Q4:Q6").copy
Range("Q4:Q6").PasteSpecial xlPasteValues
LAE.Activate
For lc = 3 To 3 'Sets the column to the third column (C)
For lr = 11 To 250 Step 1
If Cells(lr, lc).Value <> Year(Date) + 1 Then
Cells(lr, lc).Offset(0, 2).Select
Range(Selection, Selection.End(xlToRight).Offset(, -1)).copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.Locked = True
Cells(lr + 1, lc).Activate
End If
Next lr
Next lc
Range("B4:B6").copy
Range("B4:B6").PasteSpecial xlPasteValues
Range("Q4:Q6").copy
Range("Q4:Q6").PasteSpecial xlPasteValues
IGE.Protect Password:="Max" & Year(Date) + 1
LAE.Protect Password:="Max" & Year(Date) + 1
Sheets("Expense Data").Delete
Sheets("LAE Data").Delete
Sheets("Reforecast").Delete
SavePath = "\\filer01\financedrv\budget\" & Year(Date) + 1 & " Budget\" 'Sets the save path for the file
FileName = Sheets("input gen'l exp").Range("B4") & ".xlsx"
ActiveWorkbook.SaveAs (SavePath & FileName), FileFormat:=51 '51 is xlOpenXMLWorkbook - a macro free workbook
Workbooks.Open FileName:=OpenPath & OpenName
Next x
Next y
Loop
End Sub