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

Question

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

预期成果

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

我猜问题出在 End(xlUp( 语句上。非常感谢任何形式的帮助。

编辑(删除代码部分(

.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B3").Valu
.Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B4").Value
.Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B5").Value
.Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B6").Value
.Cells(.Rows.Count, "I").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C9").Value
.Cells(.Rows.Count, "J").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D9").Value
.Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C10").Value
.Cells(.Rows.Count, "L").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D10").Value
.Cells(.Rows.Count, "M").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C11").Value
.Cells(.Rows.Count, "N").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D11").Value
.Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Value = SummWb.Sheets("Upload Survey").Range("C8").Value

Answer 1

你只需要使用一次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

Answer 2

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

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 ' Use offset instead of +1 if you need to '

等等。

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