嘗試將不同文件夾中的多個工作簿合並為一個主工作簿

Question

我正在嘗試從多個工作簿中提取數據，並將這些數據合並到一個數據集中。

我開始從其中提取數據，並且運行良好。 當我嘗試添加第二個工作簿時，它正在提取數據，但只是覆蓋了第一組數據。

我最終會對位於不同文件路徑而不是同一文件夾中的文件執行 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

Answer 1

如果有一列始終填充有值（例如 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()