首页 文章

使用excel vba连续粘贴到下一个空单元格中

提问于
浏览
1

我正在编写一个宏来复制一个excel工作表中的值,并将其粘贴到另一个工作表中 . 如下所示,我有一个代码可以正确地将我的值复制并粘贴到正确的工作表中,但我希望它粘贴到第3行中的下一个空单元格,而不是仅仅单元格“C3” . 所有帮助表示赞赏 .

Private Sub CommandButton1_Click()
 Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long
Dim vMax As Variant

Set wsMaster = ThisWorkbook.Sheets("Contract Metrics")
NextRow = wsMaster.Range("A" & Rows.Count).End(xlUp).Row + 1

Set wbDATA = Workbooks.Open("C:\Documents and Settings\Michael Palkovitz\My Documents\Test\Contracts Metrics.xlsx")
With wbDATA.Sheets("Contract Task Summary(1)")
    LastRow = .Range("C" & .Rows.Count).End(xlUp).Row

    If LastRow > 1 Then
        .Range("C" & LastRow).Copy
        wsMaster.Range("C" & 3).PasteSpecial xlPasteValues
        wsMaster.Range("C" & 3).PasteSpecial xlPasteFormats
    End If
End With

wbDATA.Close False
End Sub

1 回答

  • 1

    这是您要查找的代码:

    Private Sub CommandButton1_Click()
    Dim wsMaster As Worksheet, wbDATA As Workbook
    Dim NextRow As Long, LastRow As Long
    Dim vMax As Variant
    Dim columnToPaste As Integer
    Dim lastColumnToPaste As Integer
    Dim lastColumn as Integer
    
    Set wsMaster = ThisWorkbook.Sheets("Contract Metrics")
    NextRow = wsMaster.Range("A" & Rows.Count).End(xlUp).Row + 1
    
    Set wbDATA = Workbooks.Open("C:\Documents and Settings\Michael Palkovitz\My Documents\Test\Contracts Metrics.xlsx")
    With wbDATA.Sheets("Contract Task Summary(1)")
        LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
    
        If LastRow > 1 Then
            .Range("C" & LastRow).Copy
            lastColumn = 3
            lastColumnToPaste = lastColumn + 20
            columnToPaste = lastColumn - 1
            Do
               columnToPaste = columnToPaste + 1
               If IsEmpty(wsMaster.Cells(lastRow, columnToPaste)) Then
                   wsMaster.Cells(lastRow, columnToPaste).PasteSpecial xlPasteValues
                   wsMaster.Cells(lastRow, columnToPaste).PasteSpecial xlPasteFormats
                   Exit Do
               End If
            Loop While (columnToPaste < lastColumnToPaste)
        End If
    End With
    
    wbDATA.Close False
    End Sub
    

    这只是解决问题的基本方法 . 您应该动态更新某些值(例如,要检查的最大行,由变量 lastRowToPaste 给出) .

    请注意,在两个不同的工作簿之间写入/粘贴效率非常低 . 如果必须重复此过程足够长的时间,我会:打开输入电子表格并将所有值存储在临时位置(取决于大小,数组或临时文件中),关闭它;打开目标电子表格并从此位置写入数据(不依赖于复制/粘贴) . 这是解决问题的一种快得多的方法 .

相关问题