Question

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

搜索包含5个工作表中数据的最后一个单元格。它应该搜索除“A＆＃39; A＆＃39;或者＆＃39; B＆＃39;对于数据，因为这些可能是空白也可能不是空白。
重复阵列中的所有5张
将源工作簿中的5张所有数据粘贴到工作表4＆＃39;一个接一个

我遇到的问题是可能使用了.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

试试这个宝石：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 2

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

此处您的代码已经过重构，包括其他一些未解决的小问题，以及内联评论（标有<---标记我已更改

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

Answer 3

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

console.log( self.filter)

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

在工作簿中以一系列工作表复制和粘贴数据

3 个答案: