VBA，循環瀏覽多個文件，復制/粘貼到最后一行

Question

我有使用選擇器的代碼，選擇要從中收集數據並將其粘貼到主工作簿的csv文件。 但是，數據只是在我的主工作簿的B列中替代了自身。 我知道我必須使用.End（xlUp）或.End（xlDown），不確定將其放在何處。

這是我的代碼：

Option Explicit
Dim wsMaster As Workbook, csvFiles As Workbook
Dim Filename As String
Dim File As Integer
Dim r As Long

Public Sub Consolidate()

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Title = "Select files to process"
        .Show

        If .SelectedItems.Count = 0 Then Exit Sub

        Set wsMaster = ActiveWorkbook

        For File = 1 To .SelectedItems.Count

            Filename = .SelectedItems.Item(File)

           If Right(Filename, 4) = ".csv" Then
    Set csvFiles = Workbooks.Open(Filename, 0, True)
    r = wsMaster.Sheets("Sheet1").UsedRange.Rows.Count
    csvFiles.Sheets(1).Range("AK:AK").EntireColumn.Copy Destination:=wsMaster.Sheets("Sheet1").Range("A:A").EntireColumn.Offset(0, 1)
    csvFiles.Close SaveChanges:=False 'close without saving
            End If


        Next File 'go to the next file and repeat the process

    End With

    Set wsMaster = Nothing
    Set csvFiles = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True

    End With

End Sub

從Bruce Wayne編輯了新代碼

Option Explicit
Dim wsMaster As Workbook, csvFiles As Workbook
Dim Filename As String
Dim File As Integer
Dim r As Long

Public Sub Consolidate()

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Title = "Select files to process"
        .Show

        If .SelectedItems.Count = 0 Then Exit Sub

        Set wsMaster = ActiveWorkbook

Dim copyRng As Range, destRng As Range
Dim firstRow As Long
For File = 1 To .SelectedItems.Count

    Filename = .SelectedItems.Item(File)

    If Right(Filename, 4) = ".csv" Then
        Set csvFiles = Workbooks.Open(Filename, 0, True)
        r = wsMaster.Sheets("Sheet1").UsedRange.Rows.Count

        '' This is the main new part
        Set copyRng = csvFiles.Sheets(1).Range("AK1:AK" & r)
        With wsMaster.Sheets("Sheet1")
            firstRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            Set destRng = .Range("A" & firstRow + 1).Offset(0, 1)
        End With
        copyRng.Copy destRng
        ''''''''''
        csvFiles.Close SaveChanges:=False    'close without saving
    End If
Next File

    End With

    Set wsMaster = Nothing
    Set csvFiles = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True

    End With

End Sub

Answer 1

您需要找到源和主表的最后一行。 為此，您可以對此進行調整：

EndRow = Worksheets("Sheet1").Range("A:A").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

然后，您可以使用這樣的EndRow整數將其粘貼到所需的位置。 坐標行= EndRow，列= 2或B：

Worksheets("Sheet1").Cells(EndRow, 2).Paste

或像這樣復制您想要的內容。 從A1到EndRow A的復制范圍：

Worksheets("Sheet1").Range(Cells(1, 1), Cells(EndRow, 1)).Copy

Answer 2

嘗試使用以下命令替換Set wsMaster = ActiveWorkbook下的代碼：

Dim copyRng As Range, destRng As Range
Dim firstRow As Long
For File = 1 To .SelectedItems.Count

    Filename = .SelectedItems.Item(File)

    If Right(Filename, 4) = ".csv" Then
        Set csvFiles = Workbooks.Open(Filename, 0, True)
        r = wsMaster.Sheets("Sheet1").UsedRange.Rows.Count

        '' This is the main new part
        Set copyRng = csvFiles.Sheets(1).Range("AK1:AK" & r)
        With wsMaster.Sheets("Sheet1")
            firstRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            Set destRng = .Range("A" & firstRow + 1).Offset(0, 1)
        End With
        copyRng.Copy destRng
        ''''''''''
        csvFiles.Close SaveChanges:=False    'close without saving
    End If
Next File
' etc. etc.

這將創建兩個范圍，並將相應地進行復制/粘貼。 它應該使用您的AK1:AK#行，並將其添加到wsMaster.Sheets("Sheet1")工作表的B列中。