如何缩短此VBA代码？复制和粘贴单元格

对于我粘贴到新工作表的每个单元格,下面的代码很多都是重复的.

作为一项教育活动,任何人都可以告诉我如何缩短它吗？

Sub RowForTracker()

    Worksheets.Add(After:=Worksheets(1)).Name = "ForTracker"

    Sheets("Summary").Range("C2").Copy
    Sheets("ForTracker").Range("A1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("C6").Copy
    Sheets("ForTracker").Range("B1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("C8").Copy
    Sheets("ForTracker").Range("C1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("C3").Copy
    Sheets("ForTracker").Range("D1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("H8").Copy
    Sheets("ForTracker").Range("E1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("H9").Copy
    Sheets("ForTracker").Range("F1").PasteSpecial Paste:=xlPasteValues

    Sheets("Summary").Range("C5").Copy
    Sheets("ForTracker").Range("G1").PasteSpecial Paste:=xlPasteValues

End Sub

结束子

另外一个例子,你可以如何实现CopyPaste

Sub test1()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    With T
        .[A1] = S.[C2]
        .[B1] = S.[C6]
        .[C1] = S.[C8]
        .[D1] = S.[C3]
        .[E1] = S.[H8]
        .[F1] = S.[H9]
        .[G1] = S.[C5]
    End With
End Sub

使用数组的变体

Sub test2()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    Dim CopyPaste, x%
    x = 0
    With S
        CopyPaste = Array(.[C2], .[C6], .[C8], .[C3], .[H8], .[H9], .[C5])
    End With
    For Each oCell In T.[A1:G1]
        oCell.Value = CopyPaste(x): x = x + 1
    Next
End Sub

变体使用分裂字符串

Sub test3()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    Dim CopyPaste$
    With S
        CopyPaste = .[C2] & "|" & .[C6] & "|" & .[C8] & "|" & .[C3] & "|" & .[H8] & "|" & .[H9] & "|" & .[C5]
    End With
    T.[A1:G1] = Split(CopyPaste, "|")
End Sub

使用字典的变体

Sub test4()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    Dim CopyPaste As Object: Set CopyPaste = CreateObject("Scripting.Dictionary")
    Dim oCell As Range, Key As Variant, x%
    x = 1
    For Each oCell In S.[C2,C6,C8,C3,H8,H9,C5]
        CopyPaste.Add x, oCell.Value: x = x + 1
    Next
    x = 0
    For Each Key In CopyPaste
        T.[A1].Offset(, x).Value = CopyPaste(Key)
        x = x + 1
    Next
End Sub

好吧,如果你想简化它,你可以这样做:

Sub Main()

    Dim wsS As Worksheet
    Dim wsT As Worksheet

    Set wsS = Sheets("Summary")
    Set wsT = Sheets("ForTracker")

    wsT.Range("A1").Value = wsS.Range("C2").Value
    wsT.Range("B1").Value = wsS.Range("C6").Value
    wsT.Range("C1").Value = wsS.Range("C8").Value
    wsT.Range("D1").Value = wsS.Range("C3").Value
    wsT.Range("E1").Value = wsS.Range("H8").Value
    wsT.Range("F1").Value = wsS.Range("H9").Value
    wsT.Range("G1").Value = wsS.Range("C5").Value

End Sub

这一次可能没有必要,但正如你所说,你希望有一个教育例外,你可以创建一个程序,只是为了将单元格值从一个复制到另一个.它可能看起来像这样:

Sub CopyValue(CopyFrom As Range, PasteTo As Range)
    PasteTo.Value = CopyFrom.Value
End Sub

你会这样称呼它:

CopyValue wsS.Range("C2"), wsT.Range("A1")

或者,如果你想要更清楚,就像这样:

CopyValue CopyFrom:=wsS.Range("C2"), PasteTo:=wsT.Range("A1")