时间戳

首页 > 解决方案 > 基于Value Loop的VBA Open Workbook

excel - 基于Value Loop的VBA Open Workbook

问题描述

我的代码有问题，该代码根据 C 列中的值打开工作簿并根据 B 列打开另一个工作簿。然后代码应该将工作簿 B 粘贴到工作簿 C 中，但代码似乎在打开工作簿后停止在 C 列中，并且没有进展到 B 列。

有人可以帮助我的循环吗？

Sub OpenWorkbook()

  'Open the summary  tracking and the assoicated weekly report on a loop

Dim WbSummary As String
Dim WbWeekly As String


r = 2
Do Until IsEmpty(Workbooks("Resales Summary Report").Sheets("Sheet1").Cells(r, 2)) And IsEmpty(Workbooks("Resales Summary Report").Sheets("Sheet1").Cells(r, 3))


WbSummary = Workbooks("Resales Summary Report").Sheets("Sheet1").Cells(r, 3)
WbWeekly = Workbooks("Resales Summary Report").Sheets("Sheet1").Cells(r, 2)


Workbooks.Open "C:\Users\Bjellis\Documents\Fast Track\Summary Reports\" & WbSummary & ""

Workbooks.Open "C:\Users\Bjellis\Documents\Fast Track\Weekly Files\" & WbWeekly & ""


'Copy and Paste
 
Workbooks(WbWeekly).Sheets("Sheet").Range("A8:R48").Copy
 
Workbooks(WbSummary).Sheets("Weekly Data").Range("A1").PasteSpecial
  

'Close Weekly Update Workbook
Workbooks(WbWeekly).Close SaveChanges:=False

  
'Copy a range from sheet 1 of Summary
Sheets("2020 FT Tracking").Range("B23:B29").Copy Destination:=Sheets("Weekly Data").Range("T3")

Application.CutCopyMode = False

'Formulas to add cells
Sheets("Weekly Data").Activate
    Range("U3").Formula = "=E2+E9"
    Range("U4").Formula = "=Sum(F2+G2+I2+F26+G26+I26)"
    Range("U5").Formula = "=F2+F24"
    Range("U6").Formula = "=F5+G5+I5+F27+G27+I27"
    Range("U7").Formula = "=F2+F24"
    Range("U8").Formula = "=E15+E37"
    
'Close Summary Woorkbook and Loop
Workbooks(WbSummary).Close SaveChanges:=True

r = r + 1
Loop

End Sub

标签： excelvbaloops

解决方案

将您的工作表和书籍分配给对象变量，代码将更具可读性：

Sub OpenWorkbook()

  ' Open the summary  tracking and the assoicated weekly report on a loop

  Dim WbSummary As String
  Dim WbWeekly As String

  Dim SummaryBook As Workbook
  Dim WeeklyBook As Workbook

  Dim ReportSheet As Worksheet

  Set ReportSheet = Workbooks("Resales Summary Report").Sheets("Sheet1")

  r = 2
  Do Until IsEmpty(ReportSheet.Cells(r, 2)) And IsEmpty(ReportSheet.Cells(r, 3))

    WbSummary = ReportSheet.Cells(r, 3)
    WbWeekly = ReportSheet.Cells(r, 2)

    Set SummaryBook = Workbooks.Open("C:\Users\Bjellis\Documents\Fast Track\Summary Reports\" & WbSummary)
    Set WeeklyBook = Workbooks.Open("C:\Users\Bjellis\Documents\Fast Track\Weekly Files\" & WbWeekly)

    ' Copy and Paste
    WeeklyBook.Sheets("Sheet").Range("A8:R48").Copy
    SummaryBook.Sheets("Weekly Data").Range("A1").PasteSpecial
      
    ' Close Weekly Update Workbook
    WeeklyBook.Close SaveChanges:=False
 
    ' Copy a range from sheet 1 of Summary
    Sheets("2020 FT Tracking").Range("B23:B29").Copy Destination:=Sheets("Weekly Data").Range("T3")

    Application.CutCopyMode = False

    ' Formulas to add cells
    With SummaryBook.Sheets("Weekly Data")
        .Range("U3").Formula = "=E2+E9"
        .Range("U4").Formula = "=Sum(F2+G2+I2+F26+G26+I26)"
        .Range("U5").Formula = "=F2+F24"
        .Range("U6").Formula = "=F5+G5+I5+F27+G27+I27"
        .Range("U7").Formula = "=F2+F24"
        .Range("U8").Formula = "=E15+E37"
    End With

    ' Close Summary Woorkbook and Loop
    SummaryBook.Close SaveChanges:=True

    r = r + 1

    Set SummaryBook = Nothing
    Set WeeklyBook = Nothing

  Loop

  Set ReportSheet = Nothing

End Sub

我可以在您的代码中调整其他各种内容，但我希望您能清楚地看到我所做的更改。

推荐阅读