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 

下編輯布魯斯·韋恩

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整數像這樣粘貼到您希望。使用座標row = EndRow，column = 2或B：

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

或者像這樣來複制你想要的。與A1的拷貝至EndRow答：

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列。