复制粘贴多个单元格 Excel VBA

Question

我每天有数十个单独的单元格需要从每日报告复制到主控 sheet。需要复制的单元格在日报的不同行，需要粘贴到母版的各个单元格中。

我的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

复制粘贴多个单元格 Excel VBA

Copy Paste Multiple Cells Excel VBA

excel

vba

copy-paste