VBA - 將可變行數從工作簿複製到另一個

Question

我們的辦公室最近更新爲Excel 2013，而在2010版中運行的代碼無法正常工作。我在這裏搜索了幾個線程，但還沒有找到適用於這種特殊情況的解決方案。

代碼從打開的工作簿中識別並複製一系列單元格，並將它們記錄到第二個工作簿中，一次一個單元格區域。它被設置爲一次只複製一行的原因是因爲要複製的行數隨時間而變化。自2013年更改以來，Selection.PasteSpecial函數一直在觸發調試提示。

實際上，工作表被用作路由表單。填好後，我們運行代碼並將所有相關信息保存在單獨的工作簿中。由於它是一個路由表單，其上的人數會有所不同，我們需要爲每個人排一行，以便跟蹤他們的「狀態」。

代碼：

Sub Submit() 
    'Transfer code 
    Dim i As Long, r As Range, coltoSearch As String 

    coltoSearch = "I" 

    'Change i = # to transfer rows of data. Needs to be the first row which copies over. 
    'This is to identify how many rows are to be copied over. If statement ends the for loop once an "empty" cell is reached 
    For i = 50 To Range(coltoSearch & Rows.Count).End(xlUp).Row 
     Set r = Range(coltoSearch & i) 
     If Len(r.Value) = 0 Then 
     Exit For 
     End If 

    'Copies the next row on the loop 
     Range(Cells(i, 1), Cells(i, 18)).Copy 

    'open the workbook where row will be copied to 
     Workbooks.Open FileName:= _ 
     "Workbook2" 

    'definition for the first empty row in Workbook 2, or the row under the last occupied cell in the Log 
     erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 

    'selects the first cell in the empty row 
     ActiveSheet.Cells(erow, 1).Select 

    ' Pastes the copied row from Workbook 1 into Workbook 2. First line is highlighted when debugging 
     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
     ActiveWorkbook.Save 
     ActiveWorkbook.Close 
     Application.CutCopyMode = False 

    'moves to the next row 
    Next i 

有什麼想法？我接受所有選擇。謝謝你的時間。

Answer 1

工作的替代選擇是

ActiveSheet.Cells(erow, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 

，但只是爲了確保一切都很精細，你必須設置在這裏我要粘貼的一切

dim rngToFill as range 
Set rngToFill = ActiveSheet.Cells(erow, 1) 

可能代替範圍使用ActiveSheet，您必須在打開wb後定義該表格

dim wb as Workbook, ws as worksheet 
set wb = Workbooks.Open FileName:="Workbook2" 
set ws = wb.Sheets(nameofthesheet) 'or number of the sheet 

th恩

set rngToFill = ws.Cells(erow, 1) 

那麼您可以在這個範圍內使用.PasteSpecial方法粘貼，但在這之前，儘量確保沒有合併的單元格，而我們是你要粘貼值的工作表不保護。

rngToFill.PasteSpecial xlPasteValuesAndNumberFormats 

您的代碼：

dim wb as Workbook, ws as worksheet 
set wb = Workbooks.Open(FileName:="Workbook2") 
set ws = wb.Sheets(nameofthesheet) 'or number of the sheet 
erow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
if erow = 0 then erow = 1 
set rngToFill = ws.Cells(erow, 1) 
rngToFill.PasteSpecial xlPasteValuesAndNumberFormats 

在B計劃是使用一個for循環迭代通過量要複製單元格...但它不好受慢！

Dim wb As Workbook, newWs As Worksheet, oldWs As Worksheet 
    Dim z As Integer 

    Set oldWs = ActiveSheet 
    Set wb = Workbooks.Open("Workbook2") 
    Set newWs = wb.Sheets(1) 
    erow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
    If erow = 0 Then erow = 1 

    For z = 1 To 18 
     newWs.Cells(erow, z) = oldWs.Cells(i, z).Value 
    Next z 
    ActiveWorkbook.Save 
    ActiveWorkbook.Close 
    Application.CutCopyMode = False 

    'moves to the next row 
Next i