Jak mogę skrócić ten kod VBA? Kopiowanie i wklejanie komórek

Question

Wiele z poniższych kodów jest duplikowanych dla każdej wklejonej komórki do nowego arkusza.

Czy w ramach ćwiczeń edukacyjnych każdy może pokazać mi, w jaki sposób mogę go skrócić?

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

Answer 1

kolejne dodatkowe przykłady, jak można osiągnąć 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 

wariant użyciu tablicę

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 

wariant użyciu Split String

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 

wariant z wykorzystaniem słownika

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 

Answer 2

Cóż, jeśli chcesz tylko uproszczenie, można to zrobić:

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 

To może nie być konieczne, tym razem, ale jak pan powiedział, chciałeś w przypadku zajęć edukacyjnych można utworzyć procedurę służącą do kopiowania wartości komórek między sobą. To może wyglądać następująco:

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

I byłoby to nazwać tak:

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

Albo alternativelly, jeśli chcesz być bardzo jasne, jak to:

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

Answer 3

Try to:

 Sub RowForTracker() 

      Dim wksSummary   As Worksheet 
      Dim wksForTracker  As Worksheet 

      Worksheets.Add(After:=Worksheets(1)).Name = "ForTracker" 
      Set wksSummary = Sheets("Summary") 
      Set wksForTracker = Sheets("ForTracker") 

      With wksForTracker 
       .Range("A1").Value = wksSummary.Range("C2").Value 
       .Range("B1").Value = wksSummary.Range("C6").Value 
       .Range("C1").Value = wksSummary.Range("C8").Value 
       .Range("D1").Value = wksSummary.Range("C3").Value 
       .Range("E1").Value = wksSummary.Range("H8").Value 
       .Range("F1").Value = wksSummary.Range("H9").Value 
       .Range("G1").Value = wksSummary.Range("C5").Value 
      End With 

     End Sub 

Answer 4

Jeden sposób

Dim target As Range, item As Range, i As Long 
With Worksheets.Add(After:=Worksheets(1)) 
    .Name = "ForTracker" 
    Set target = .Range("A1") 
End With 

For Each item In Sheets("summary").Range("C2,C6,C8,C3,H8,H9,C5") 
    target.Offset(0, i).value = item.value 
    i = i + 1 
Next