複製/粘貼使用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的許多數據表

回答

相關問題