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

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

2 个答案: