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