Делай пока идиотизм петли - PullRequest
0 голосов
/ 30 августа 2018

Я не очень хорошо объяснил с первого раза. То, что я пытаюсь сделать, это взять рабочую книгу, вытащить бюджетный центр из набора листов как 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...