尝试使用Excel VBA将来自多个电子表格的数据合并在一起,但是我的循环不断保存以前保存的数据

时间:2018-10-04 21:10:37

标签: excel vba excel-vba

我找到了一个网站,该网站带有一个宏,可让您完成文件夹中所有电子表格的循环操作。我已将此宏用作下面的宏的基础:See Link Here

我已经能够成功地将其用于其他几个项目,但是我在当前项目中遇到了一些问题。我在试图打开,复制数据然后粘贴到主电子表格的文件夹中有许多电子表格。目标是将来自多个电子表格的所有数据放入一个单一的电子表格中。文件夹中许多电子表格的列表是一个动态列表,将随着时间的变化而变化。因此,我不能简单地单独引用每个电子表格,这就是为什么我试图使用上面链接中的循环策略的原因。

我遇到的问题是某些粘贴被粘贴到了先前电子表格的值上。因此,不是将每个电子表格粘贴在先前值的底部,而是将某些电子表格粘贴在中间并覆盖了我需要的信息。我认为我的问题是,当我进入row.count,代码的复制/粘贴部分以及i&j的变量分配不正确时,excel对要引用哪个电子表格感到困惑。但是我不知道如何解决这个问题。我没主意了,彻底沮丧了!抱歉,如果我要修改一些基本知识,但对VBA还是比较陌生。

Sub CombineReports()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim i As Integer
Dim j As Integer

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  myPath = "I:\Pricing\mt access\Tier Reports\Final Reports\"

'Target Path with Ending Extention
  myFile = Dir(myPath)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Ensure Workbook has opened before moving on to next line of code
    DoEvents

    'Worksheet tasks

    i = wb.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
    wb.Worksheets(1).Range("A5", "N" & i).Copy
    Workbooks.Open ("I:\Pricing\mt access\Tier Reports\Final Reports\Combined Report\CombinedTierReport.xlsx")
    j = Workbooks("CombinedTierReport.xlsx").Worksheets("AllStores").Range("B" & Rows.Count).End(xlUp).Row
    Workbooks("CombinedTierReport.xlsx").Worksheets("AllStores").Range("A" & j + 1, "N" & i).PasteSpecial xlPasteValues
    Workbooks("CombinedTierReport.xlsx").Save
    Workbooks("CombinedTierReport.xlsx").Close

    DoEvents

    'Save and Close Workbook
    Application.DisplayAlerts = False
    wb.Close SaveChanges:=False
    Application.DisplayAlerts = True
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
        Loop

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:1)

Range("A" & j + 1, "N" & i)更改为Range("A" & j + 1)。 a)范围有误,b)您只需要粘贴的左上角单元格。

...
i = wb.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
wb.Worksheets(1).range("A5", "N" & i).Copy
with Workbooks.Open ("I:\Pricing\mt access\Tier Reports\Final Reports\Combined Report\CombinedTierReport.xlsx")
    j = .Worksheets("AllStores").Range("B" & Rows.Count).End(xlUp).Row
    .Worksheets("AllStores").Range("A" & j + 1).PasteSpecial xlPasteValues
    .Save
    .Close savechanges:=false
end with
...