复制粘贴多个单元格Excel VBA

Question

我每天需要将数十个单个单元格从每日报告复制到母版表。 在每日报告的不同行上找到需要复制的单元格，并且需要将其粘贴到母版中的各个单元格中。

我的VBA：

`Sub COPYCELL()
Dim wbk As Workbook

strFirstFile = "c:\daily_report-2016-07-19.xlsx"
strSecondFile = "c:\testbook.xlsx"

Set wbk = Workbooks.Open(strFirstFile)
With wbk.Sheets("(Data)")

    Range("C31", "D31", "E31").Copy



End With

Set wbk = Workbooks.Open(strSecondFile)
With wbk.Sheets("Sheet1")
    Range("KD213", "KE213", "KJ213").PasteSpecial




End With

End Sub

`

所以C31转到KD213，D31到KE213等。但是这会产生错误，因为excel只能处理2个要复制的单元格。

有人知道如何添加其他复制单元和目的地吗？

谢谢！

Answer 1

这是一个简单的方法：

Sub COPYCELL()

    Dim wbk1 As Workbook, wbk2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet

    strFirstFile = "c:\daily_report-2016-07-19.xlsx"
    strSecondFile = "c:\testbook.xlsx"

    Set wbk1 = Workbooks.Open(strFirstFile)
    Set ws1 = wbk1.Sheets("(Data)")

    Set wbk2 = Workbooks.Open(strSecondFile)
    Set ws2 = wbk2.Sheets("Sheet1")

    With ws2

        .Range("KD213").Value = ws1.Range("C31").Value
        .Range("KE213").Value = ws1.Range("D31").Value
        .Range("KJ213").Value = ws1.Range("E31").Value

    End With

End Sub

Answer 2

您可以使用一个简短的子例程Sub CopyManyRanges（Range_Orig As String，Range_Dest As String）来调用任意多个范围（当前为手动）。

期权明确部分：

Option Explicit

Dim wb_first As Workbook
Dim wb_second As Workbook
Dim sht_data As Worksheet
Dim sht_1 As Worksheet

您的COPYCELL例程：

Sub COPYCELL()

Dim strFirstFile As String
Dim strSecondFile As String  

strFirstFile = "c:\daily_report-2016-07-19.xlsx"
strSecondFile = "c:\testbook.xlsx"

Set wb_first = Workbooks.Open(strFirstFile)
Set wb_second = Workbooks.Open(strSecondFile)

Set sht_data = wb_first.Sheets("(Data)")
Set sht_1 = wb_second.Sheets("Sheet1")

' you can add a For Loop here
Call CopyManyRanges("C31", "KD213")
Call CopyManyRanges("D31", "KE213")
Call CopyManyRanges("E31", "KJ213")

End Sub

Sun CopyManyRanges例程：

Sub CopyManyRanges(Range_Orig As String, Range_Dest As String)

sht_data.Range(Range_Orig).Copy
sht_1.Range(Range_Dest).PasteSpecial

End Sub

Answer 3

这是通过捕获范围然后遍历它们的另一种方法。 只需确保以正确的顺序设置范围即可。

Sub COPYCELL()

    Dim wbk As Workbook
    Dim strFile as String

    strFile = "c:\daily_report-2016-07-19.xlsx"
    Set wbk = Workbooks.Open(strFile)

    Dim rng1 as Range 
    Set rng1 = wbk.Sheets("(Data)").Range("C31,D31,E31") 'add more as needed

    wbk.Close false

    strFile = "c:\testbook.xlsx"
    Set wbk = Workbooks.Open(strFile)

    Dim rng2 as Range
    Set rng2 = wbk.Sheets("Sheet1").Range("KD213,KE213,KJ213") 'add more as needed 

    Dim i as Long
    For each cel in rng2
        cel.Value = rng1.Cells(i+1)
        i = i + 1
    Next

    wkb.Close True

End Sub