Copy/Paste Viele Datenblätter mit XLDown und Kopieren PasteSpecial

Question

Ich versuche, viele Daten von vielen Blättern zu einem anderen zu kopieren und die Zeile: toSheet.Range(Cells(toRow, toCol), Cells(toRow, toCol)).PasteSpecial xlPasteValues bleibt mit "Runtime Error 1004" Sie können; t einfügen hier b/c Kopieren Paste Größe sind nicht gleich ... Wählen Sie nur eine Zelle ... "

Ich weiß nicht, wie das zu beheben ist. Der springende Punkt ist, nichts "auszuwählen"! Ich versuche, Auswahlen zu vermeiden.

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

In dieser Zeile

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

... die xlDown an der Unterseite des worksheeet den ganzen Weg geht. Wenn fromRow die Zeile 2 war, dann sind es 1.048.575 Zeilen. Wenn du jetzt zum Einfügen gehst und du startest, wo toRow etwas größer als vonRow ist, dann hast du nicht genug Zeilen, um die vollständige Kopie zu erhalten.

Ändern der .Copy Linie,

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

Durch von unten nach oben suchen, werden Sie immer noch alle Ihre Daten bekommen, und es ist unwahrscheinlich, dass Sie in das gleiche Problem laufen wird (obwohl theoretisch möglich) .