复制/粘贴使用xlDown和复制PasteSpecial的许多数据表

我想从许多工作表复制大量的数据到另一个和行：toSheet.Range(Cells(toRow, toCol), Cells(toRow, toCol)).PasteSpecial xlPasteValues保持失败，出现“运行时错误1004你可以;这里粘贴B/C复制粘贴大小不一样...只选择一个单元...“复制/粘贴使用xlDown和复制PasteSpecial的许多数据表

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

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

来源

2017-06-15 Saladsamurai

在这一行，

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

...的xlDown被一路去到worksheeet的底部。如果fromRow是第2行，那么这是1,048,575行。如果你现在去粘贴，并且你开始从哪里来比从哪里来的东西更大，那么你没有足够的行来接收完整的副本。

更改.Copy线，

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

通过从下往上看，你仍然会得到所有数据，这是不可能的，你会遇到同样的问题（虽然理论上是可能的）。

来源

2017-06-15 01:03:54 Jeeped

xlDown不会总是**一直走到工作表的底部，但是如果原始单元格是该列中最后一个具有值的单元格，则会发生。这与轻敲[ctrl] + [向下箭头]相同。 – Jeeped

原点单元格不是最后一个单元格，下面没有空白。我不能使用xlUp，因为它会包含标题。 – Saladsamurai

如果'.Cells（fromRow，fromCol）'是列中的第二个单元格，然后从那里抓取所有内容到'.Cells（.rows.count，fromCol）.End（xlUp）'你应该没问题。除非标题是整个列中的** only **值，否则不会获取标题。 – Jeeped

复制/粘贴使用xlDown和复制PasteSpecial的许多数据表

回答

相关问题