将多个excel工作簿合并为一个新工作表

Question

我需要将多个excel工作簿合并到一个工作表中..我找到了下面的编码，但它将工作表合并成行。请帮我将工作簿合并到一页中的列

例如，我有两个以下列的工作簿：

我需要将它们合并为单页，如下所示：

Option Explicit

Sub ImportCSV()

    Dim strSourcePath As String
    Dim strDestPath As String
    Dim strFile As String
    Dim strData As String
    Dim x As Variant
    Dim Cnt As Long
    Dim r As Long
    Dim c As Long

    Application.ScreenUpdating = False

    'Change the path to the source folder accordingly
    strSourcePath = "C:\Path\"

    If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"

    'Change the path to the destination folder accordingly
    strDestPath = "C:\Path\"

    If Right(strDestPath, 1) <> "\" Then strDestPath = strDestPath & "\"

    strFile = Dir(strSourcePath & "*.csv")

    Do While Len(strFile) > 0
        Cnt = Cnt + 1
        r = Cells(Rows.Count, "A").End(xlUp).Row + 1
        Open strSourcePath & strFile For Input As #1
            Do Until EOF(1)
                Line Input #1, strData
                x = Split(strData, ",")
                For c = 0 To UBound(x)
                    Cells(r, c + 1).Value = Trim(x(c))
                Next c
                r = r + 1
            Loop
        Close #1
        Name strSourcePath & strFile As strDestPath & strFile
        strFile = Dir
    Loop

    Application.ScreenUpdating = True

    If Cnt = 0 Then _
        MsgBox "No CSV files were found...", vbExclamation

End Sub

Answer 1

要改变的地方就在这里：

r = Cells(Rows.Count, "A").End(xlUp).Row + 1
Open strSourcePath & strFile For Input As #1
     Do Until EOF(1)
         Line Input #1, strData
         x = Split(strData, ",")
         For c = 0 To UBound(x)
             Cells(r, c + 1).Value = Trim(x(c))
         Next c
         r = r + 1
     Loop

这里引用的是Rows ..它的值在循环中保持不变。 另一方面，c用作指定行中哪一列放置x的值的方法。

简单地交换这些参考文献。 类似的东西：

c = Cells(Cols.Count, "A").End(xlUp).Col + 1
Open strSourcePath & strFile For Input As #1
     Do Until EOF(1)
         Line Input #1, strData
         x = Split(strData, ",")
         For r = 0 To UBound(x)
             Cells(r, c).Value = Trim(x(r))
         Next r
         c = c + 1
     Loop