在工作表数组中的工作簿之间复制和粘贴数据

Question

我迷路了，并试图在多个论坛上找到这个特定问题，但似乎无法将其拼凑起来。希望非常快速的问题。此代码旨在：

• 在 5 个工作表中搜索包含数据的最后一个单元格。它应该搜索除“A”或“B”列之外的数据，因为这些数据可能为空，也可能不为空。
• 对数组中的所有 5 个工作表重复
• 将源工作簿中 5 个工作表中的所有数据依次粘贴到“工作表 4”上

我遇到的问题是 maybe usedrange.copy 奇怪地复制了 5 个工作簿中的所有数据。它似乎没有复制所有数据（也许计算列 A 以查找最后使用的行并基于此进行复制？）。

是否有不同的方式来实现我需要做的事情？我认为这会更容易，因为它只是从 5 张纸上复制所有数据并粘贴到不同的 wkbk 中……但是……不。非常感谢任何帮助。

    Sub Notes2()
'Last row in column
Dim WS As Worksheet, shAry As Variant, i As Long
Dim AOFF As Range
Dim rOWIS As Integer
Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
Set WS = Worksheets("Sheet 4")
With WS
    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
End With
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(vFile)
With wb2
    shAry = Array(.Sheets("Week 1"), .Sheets("Week 2"), .Sheets("Week 3"), .Sheets("Week 4"), .Sheets("Over 30"))
End With
    For i = LBound(shAry) To UBound(shAry)
        shAry(i).UsedRange.Copy
        wb.Activate
        WS.Cells(Rows.Count, 3).End(xlUp).End(xlUp)(2).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    Next
Application.ScreenUpdating = True
'Close
wb2.Close False
End Sub

Answer 1

此代码找到了粘贴数据的正确位置，因此不会丢失或覆盖任何内容（例如，C 列中没有数据的第一行：）。

Sub Rectangle1_Click()

Dim WS As Worksheet
Dim wb2 As Workbook
Dim vFile As Variant
Dim shAry As Variant
Dim sh As Variant

Set WS = ActiveWorkbook.Worksheets("Sheet 1")

'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(vFile)

With wb2
    shAry = Array(.Sheets("Week 1"), .Sheets("Week 2"), .Sheets("Week 3"), .Sheets("Week 4"), .Sheets("Over 30"))
End With
For Each sh In shAry
    Dim LastCell As Range
    Set LastCell = WS.Range("C:O").Find(What:="*", SearchDirection:=xlPrevious)
    If LastCell Is Nothing Then Set LastCell = WS.Range("C1")
    Range(sh.Cells(1, 1), sh.Cells.SpecialCells(xlCellTypeLastCell)).Copy
    WS.Cells(LastCell.Row + 1, 3).PasteSpecial xlPasteValues
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True
wb2.Close False
End Sub

注意：我删除了不必要的代码；有关解释，请参阅以前的答案。

Answer 2

试试这个宝石：cells.SpecialCells(xlCellTypeLastCell)
https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-specialcells-method-excel

尝试以下方法：

Dim sh as Variant

For Each sh In shAry
    Range(sh.cells(1,1),sh.cells.SpecialCells(xlCellTypeLastCell)).Copy
    'wb.Activate 'Leave out. Dont need this.
    WS.Cells(Rows.Count, 3).End(xlUp).End(xlUp)(2).PasteSpecial xlPasteValues
    'Application.CutCopyMode = False 'If you really need this, put it after loop.
Next

Application.CutCopyMode = False

Answer 3

额外的.End(xlUp) 是导致您的问题的原因。 （即使你说你在评论中删除了它，它仍然在你的示例文件中）

这是您重构的代码，包括解决的其他一些小问题和内联 cmets（在我所做的更改上标有 <---

Sub Notes2()
    'Last row in column
    Dim ws As Worksheet, shAry As Variant, i As Long
    Dim AOFF As Range
    Dim rOWIS As Long              ' <-- better to use long
    Dim wb As Workbook, wb2 As Workbook
    Dim vFile As Variant
    Dim LastCell As Range          ' <-- Define all variables
    Dim LastCellRowNumber As Long  ' <--
    'Set source workbook
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("Sheet 4") ' <-- specify context
    'With ws                          ' <--- not used in rest of code
    '    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    '    LastCellRowNumber = LastCell.Row + 1
    'End With
    'Open the target workbook
    vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
        1, "Select File To Open", , False)
    'if the user didn't select a file, exit sub
    If vFile = False Then Exit Sub   ' <--  simpler
    Application.ScreenUpdating = False
    Set wb2 = Workbooks.Open(vFile)
    With wb2
        shAry = Array(.Sheets("Week 1"), .Sheets("Week 2"), .Sheets("Week 3"), .Sheets("Week 4"), .Sheets("Over 30"))
    End With
    For i = LBound(shAry) To UBound(shAry)
        shAry(i).UsedRange.Copy
        'wb.Activate                 ' <--- not needed
        ws.Cells(ws.Rows.Count, 3).End(xlUp)(2).PasteSpecial xlPasteValues ' <-- specify ws, remove extra End
        Application.CutCopyMode = False
    Next
    Application.ScreenUpdating = True
    'Close
    wb2.Close False
End Sub