VBA，循环多个文件，复制/粘贴到最后一行

我有我的代码，它使用一个select器，我select哪些csv文件，我想从中收集数据并粘贴到我的主工作簿。 但是，数据只是在我的主工作簿的B列中进行replace。 我知道我必须使用.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 A：

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

Answer 2

尝试使用以下代码replaceSet 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. 

这将创build两个范围，并将相应地复制/粘贴。 它应该把你的AK1:AK#行，并添加到您的wsMaster.Sheets("Sheet1")工作表的B列。