Question

我第一次做的解释不好。我要做的是拿一个工作簿，从工作表集中将预算中心拉为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

循环做白痴

0 个答案: