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

Question

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

我开始从其中一个提取数据，并且工作正常。 当我尝试添加第二个工作簿时，它正在提取数据，但仅覆盖第一组数据。

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

每本工作簿都具有相同的命名标签，并且标题完全相同。

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

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

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

wbPrior2.Sheets（“ wsPrior2”）。Range（“ A2：AA”＆Prior2LastRow）.copy目标：= ThisWorkbook.Sheets（“ wsCurrent”）。Cells（ 31 < / em>，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

Answer 1

如果有一列始终填充有值（例如，ID列；在示例中，我使用列“ A”），则可以使用nextRow代替31。 / p>

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()