时间戳

首页 > 解决方案 > 尝试将不同文件夹中的多个工作簿合并为一个主工作簿

excel - 尝试将不同文件夹中的多个工作簿合并为一个主工作簿

问题描述

我正在尝试从多个工作簿中提取数据，并将数据组合到一个数据集中。

我开始从一个中提取数据，它工作得很好。当我尝试添加第二个工作簿时，它正在提取数据，但只是覆盖了第一组数据。

对于位于不同文件路径而不是同一文件夹中的文件，我最终将执行 6 次不同的操作。

每个工作簿都有相同的命名选项卡，并且标题完全相同。

A1:AA1 是标题。- 源文件和主文件完全相同。

我正在尝试提取数据并粘贴到主工作表上的标题下方，并在我从每个工作簿中提取数据时继续粘贴在下方。

我正在寻找一种解决方案，将“31”更改为粘贴到下一个未使用的行，因为在源文件中输入数据时，31 会发生变化。

wbPrior2.Sheets("wsPrior2").Range("A2:AA" & Prior2LastRow).copy Destination:=ThisWorkbook.Sheets("wsCurrent").Cells( 31 , 1)

Option Explicit

Sub RectangleRoundedCorners3_Click()
    ' clear current data
    Sheets("wsCurrent").Rows("2:" & Sheets("wsCurrent").Rows.Count).ClearContents
    
    ' open First File to Combine
    Dim fileNameFullPath As String
    fileNameFullPath = "C:\Filelocationpath\wbPrior.xlsx"
    Workbooks.Open Filename:=fileNameFullPath, ReadOnly:=True
    ' ----- copy file. after opening workbook, it becomes an active workbook
    Dim wbPrior As Workbook
    Set wbPrior = ActiveWorkbook
    ' --- get LastRow
    Dim PriorLastRow As Integer
    ' -- wsPrior
    PriorLastRow = wbPrior.Sheets("wsPrior").Cells(Rows.Count, 1).End(xlUp).Row
    ' --- copy wsPrior to wsCurrent
    wbPrior.Sheets("wsPrior").Range("A2:AA" & PriorLastRow).copy Destination:=ThisWorkbook.Sheets("wsCurrent").Cells(2, 1)
    ' --- close wbPrior
    wbPrior.Close
    
    'Second Source File Data Pull
    ' --- open "wbPrior2.xlsx"
    Dim fileNameFullPath2 As String
    fileNameFullPath2 = "C:\Filelocationpath2\wbPrior2.xlsx"
    Workbooks.Open Filename:=fileNameFullPath2, ReadOnly:=True
    ' ----- copy file. after opening workbook, it becomes an active workbook
    Dim wbPrior2 As Workbook
    Set wbPrior2 = ActiveWorkbook
    ' --- get LastRow
    Dim Prior2LastRow As Integer
    ' -- wsPrior2
    Prior2LastRow = wbPrior2.Sheets("wsPrior2").Cells(Rows.Count, 1).End(xlUp).Row
    ' --- copy wsPrior to wsCurrent
    wbPrior2.Sheets("wsPrior2").Range("A2:AA" & Prior2LastRow).copy Destination:=ThisWorkbook.Sheets("wsCurrent").Cells(31, 1)
    ' --- close wbPrior
    wbPrior2.Close
    
    
End Sub

标签： excelvba

解决方案

如果有一列总是用一个值填充（例如，一个 ID 列；在示例中我使用列“A”），那么您可以使用nextRow而不是31.

dim next Row as long
nextRow = ThisWorkbook.Sheets("wsCurrent").Cells(1,1).End(xlDown).Row +1

或者

dim next Row as long
nextRow = ThisWorkbook.Sheets("wsCurrent").Cells(Rows.Count, 1).End(xlUp).Row + 1

这与您已经使用的方式非常相似，例如

Prior2LastRow = wbPrior2.Sheets("wsPrior2").Cells(Rows.Count, 1).End(xlUp).Row

此外，如果您想避免对所有 6 个文件进行硬编码，您还可以使用此功能按顺序选择文件。

Public Function f_FiledialogChooseData() As Variant
Dim fd As FileDialog
f_FiledialogChooseData= 0
Set fd = Application.FileDialog(msoFileDialogFilePicker)
If fd.Show = True Then
    f_FiledialogChooseData= fd.SelectedItems(1)
Else
    Debug.Print "The user pressed >>cancel<<"
End If
Set fd = Nothing 
End Function

结合

fileNameFullPath = f_FiledialogChooseData()

推荐阅读