Excel 将数据从多个工作簿复制到一个主文件：数据不在同一行中输入

我有一个代码可以从多个工作簿复制到一个主文件。但这里的问题是，数据文件可能包含一个空行。因此，每次添加新的数据，而不是在同一行中，它将向上移动以填充所有空白列。对不起，如果我的话不清楚，英语不是我的第一语言。我在这里附上了这个例子

预期结果

A     B      C      D       E
bb   1234    cc     
ff   3242    ff     
fjn  7643    jk    fjnnD  fjnnE
gwd  9754    jk    gjwdD  gjwdE

我得到的结果

A     B      C      D       E
bb   1234    cc     fjnnD  fjnnE
ff   3242    ff     gjwdD  gjwdE
fjn  7643    jk    
gwd  9754    jk    

这是我的密码

Sub UploadData()

Dim SummWb As Workbook
Dim SceWb As Workbook

'Get folder containing files
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    On Error GoTo Error_handler
    myFolderName = .SelectedItems(1)
    'Err.Clear
    'On Error GoTo 0
End With

If Right(myFolderName, 1) <> "\" Then myFolderName = myFolderName & "\"
    'Settings
    Application.ScreenUpdating = False
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Set SummWb = ActiveWorkbook
    'Get source files and append to output file
    mySceFileName = Dir(myFolderName & "*.*")

        Do While mySceFileName <> "" 'Stop once all files found
            Application.StatusBar = "Processing: " & mySceFileName
            Set SceWb = Workbooks.Open(myFolderName & mySceFileName) 'Open file found
                With SummWb.Sheets("Master List")
                                     Dim maxLastRow As Long
             Dim columnsToAppendTo As Variant
             columnsToAppendTo = Array("A", "B", "C", "D", "E", "I", "J", "K", "L", "M", "N", "F")
             Dim index As Long

            For index = LBound(columnsToAppendTo) To UBound(columnsToAppendTo)
            maxLastRow = Application.Max(.Cells(.Rows.Count, columnsToAppendTo(index)).End(xlUp).Row, maxLastRow)
            Next index

                .Cells(maxLastRow + 1, "A").Value = SceWb.Sheets("Survey").Range("B3").Value
                .Cells(maxLastRow + 1, "C").Value = SceWb.Sheets("Survey").Range("B4").Value
                .Cells(maxLastRow + 1, "D").Value = SceWb.Sheets("Survey").Range("B5").Value
                .Cells(maxLastRow + 1, "E").Value = SceWb.Sheets("Survey").Range("B6").Value
                .Cells(maxLastRow + 1, "I").Value = SceWb.Sheets("Survey").Range("C9").Value
                .Cells(maxLastRow + 1, "J").Value = SceWb.Sheets("Survey").Range("D9").Value
                .Cells(maxLastRow + 1, "K").Value = SceWb.Sheets("Survey").Range("C10").Value
                .Cells(maxLastRow + 1, "L").Value = SceWb.Sheets("Survey").Range("D10").Value
                .Cells(maxLastRow + 1, "M").Value = SceWb.Sheets("Survey").Range("C11").Value
                .Cells(maxLastRow + 1, "N").Value = SceWb.Sheets("Survey").Range("D11").Value
                .Cells(maxLastRow + 1, "F").Value = SummWb.Sheets("Upload Survey").Range("C8").Value
                End With
            SceWb.Close (False) 'Close Workbook
            mySceFileName = Dir

        Loop
MsgBox ("Upload complete.")
'Settings and save output file
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
SummWb.Activate
SummWb.Save 'save automaticallly
Application.ScreenUpdating = True
Exit Sub
Error_handler:
MsgBox ("You cancelled the action.")

End Sub

---

未经测试。也许有更好的方法可以做到这一点，但在这一行之后：

With SummWb.Sheets("Master List")

放

然后重新编写代码中实际写入主文件的部分，如下所示：

.Cells(maxLastRow + 1, "A").Value = SceWb.Sheets("Survey").Range("B3").Value ' Use offset instead of +1 if you need to '

等等

---

主要区别在于，您首先/提前计算出所有列的最后一行，然后为每列使用特定的最后一行值。

您只需要使用

End（xlUp）

一次，然后所有其他值都应该放在同一行上：不要在每列中单独运行它。您需要选择一个没有空格的列

例如：使用可乐

With SummWb.Sheets("Master List").Cells(rows.count,1).end(xlup).offset(1,0).Entirerow
    .cells(1).value = 'whatever
    .cells(2).value = 'other value
    'etc etc
end with

---

嗨，它的编译错误是“列表分隔符或”。对于line Column ToAppendToSorry，忘记了关闭双引号。现在？它工作了吗？哦，等等。我先试试。嗨，我的行maxLastRow出现编译错误，特别是.Rows部分。我已经更改了行以将代码放在后面（它需要在

With

块中）.现在运气好吗？不幸的是，我目前无法访问桌面进行测试。您只需要使用一次End（xlUp），然后所有其他值都应该位于同一行：不要在每列中单独运行它。您需要选择一个没有空格的列。这意味着，如果我指定a列使用End（xlUp），然后我需要从其他列中删除它？嗨，我使用了数字，它移动了我所有的数据。所以我可以用字母表代替数字吗？嗨，蒂姆，非常感谢！！它很有效。谢谢你的输入我今天学到了新东西

.Cells(maxLastRow + 1, "A").Value = SceWb.Sheets("Survey").Range("B3").Value ' Use offset instead of +1 if you need to '

With SummWb.Sheets("Master List").Cells(rows.count,1).end(xlup).offset(1,0).Entirerow
    .cells(1).value = 'whatever
    .cells(2).value = 'other value
    'etc etc
end with