Question

如果有人帮助我解决这个问题，我真的很感激。不可否认，我对这一切都很陌生，所以请放轻松我。我有一个代码，可以将大量工作簿中的数据合并到一个主工作表中。我瞄准来自不同工作簿的相同单元格（例如，来自所有工作簿的A5，并将它们粘贴到我的工作表中作为单元格A1下的列，以及来自B1列下的工作簿中的A13等）。但是，当我从＆＃34; A＆＃34;更改此行的代码时到＆＃34; B＆＃34;并再次运行它以从工作簿中获取其他数据列：

Set CopyRng = Wkb.Sheets(1).Cells(9, 1)

Set Dest = shtDest.Range("B" & 
shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)

它对角线到下一列和下一行。例如当A1到A11完成时，它会在目标工作表中开始粘贴到B12（对角线），而不是从B1（并排）开始。

以下是整个代码：

Sub MergeFiles()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer

    RowofCopySheet = 1 'Row to start on in the sheets you are copying from

    ThisWB = ActiveWorkbook.Name

    path = "C:\batch"

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.csv", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
            Set CopyRng = Wkb.Sheets(1).Cells(3, 1)
            Set Dest = shtDest.Range("A" & 
shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
            CopyRng.Copy Dest
            Wkb.Close False
        End If

        Filename = Dir()
    Loop

    Range("A1").Select

    Application.EnableEvents = True
    Application.ScreenUpdating = True

    MsgBox "Done!"
End Sub

Answer 1

更改此

Set Dest = shtDest.Range("A" & 
shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)

到这个

Set Dest = shtDest.Range("A" & shtDest.Cells(shtDest.Rows.Count, "A").End(xlUp).Row + 1)

确保第二次运行时使用：

Set Dest = shtDest.Range("B" & shtDest.Cells(shtDest.Rows.Count, "B").End(xlUp).Row + 1)

虽然如果

shtDest.Cells(shtDest.Rows.Count, "A").End(xlUp).Row  = 1

OR

shtDest.Cells(shtDest.Rows.Count, "B").End(xlUp).Row  = 1

你不想像第一行那样添加+ 1进行粘贴。

无法让脚本并排整合数据

1 个答案: