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