Question

我正在尝试将许多工作表中的大量数据复制到另一个工作表而且行：toSheet.Range(Cells(toRow, toCol), Cells(toRow, toCol)).PasteSpecial xlPasteValues一直失败，“运行时错误1004你可以; t粘贴这里b / c复制粘贴大小不一样.. 。只选择一个单元格......“

我不知道如何解决这个问题。这一点的重点是不要“选择”任何东西！我试图避免使用选择。

Option Explicit
    Sub CopyFastenerMargins()
    Dim StartTime As Double     'track code run time
    Dim secondsElapsed As Double
    StartTime = Timer
    Application.ScreenUpdating = False  'turn off blinking
    Dim nameRange As Range, r As Range, sht As Range
    Dim fromSheet As Worksheet, toSheet As Worksheet, sheetName As String
    Dim fromRow As Long, fromCol As Long, LCID As Variant
    Dim toRow As Long, toCol As Long, rowCount As Long
    Dim FSY As Range, FSYvalue As Double
    Dim FSU As Range, FSUvalue As Double
    Dim analysisType As String, analysisFlag As Integer

    'Set range containing worksheet names to loop thru
    Set nameRange = Worksheets("TOC").Range("A44:A82")
    'Set destination worksheet
    Set toSheet = Sheets("SuperMargins")

    'find data and copy to destination sheet
    'Loop thru sheets
    Dim i As Long
    For i = 1 To 3
        'pickup current sheet name
        sheetName = nameRange(i)
         Set fromSheet = Sheets(sheetName)
        'find starting location (by header) of data and set range
        Set r = fromSheet.Cells.Find(What:="Minimums by LCID", After:=fromSheet.Cells(1, 1), Lookat:=xlWhole, MatchCase:=True)
        Set r = r.Offset(2, -1)
        fromRow = r.Row
        fromCol = r.Column
        'set row column indices on destination sheet
        toCol = 2
        toRow = lastRow(toSheet) + 1 'get last row using function

        'Copy LCID Range
        fromSheet.Activate
        fromSheet.Range(Cells(fromRow, fromCol), Cells(fromRow, fromCol).End(xlDown)).Copy
        toSheet.Activate
**'********************************NEXT LINE THROWS ERROR**
        toSheet.Range(Cells(toRow, toCol), Cells(toRow, toCol)).PasteSpecial xlPasteValues
    Application.ScreenUpdating = True
    secondsElapsed = Round(Timer - StartTime, 2)
    MsgBox ("Done.  Time:  " & secondsElapsed)

    End Sub


    ' function to determine last row of data
    Function lastRow(sht As Worksheet) As Long

        ' source: http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba
        With sht
            If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                lastRow = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row
            Else
                lastRow = 1
            End If
        End With

    End Function

Answer 1

在这一行中，

fromSheet.Range(Cells(fromRow, fromCol), Cells(fromRow, fromCol).End(xlDown)).Copy

...... xlDown一直到工作室的底部。如果fromRow是第2行，那么这是1,048,575行。如果你现在去粘贴，你开始在哪里toRow比fromRow更大，那么你没有足够的行来接收完整的副本。

将.Copy行更改为，

with fromSheet
    .Range(.Cells(fromRow, fromCol), .Cells(.rows.count, fromCol).End(xlUp)).Copy
end with

从下往上看，您仍然可以获得所有数据，并且您不太可能遇到同样的问题（尽管理论上可行）。

使用xlDown和Copy PasteSpecial复制/粘贴多张数据表

1 个答案: