Wie kann ich diesen VBA-Code verkürzen? Kopieren und Einfügen von Zellen

Question

Eine Menge des folgenden Codes wird für jede Zelle dupliziert, die ich in ein neues Arbeitsblatt einfügen möchte.

Als eine pädagogische Übung, kann mir jemand zeigen, wie ich es verkürzen könnte?

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

noch weitere Beispiele, wie Sie 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 

Variante mit Array

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 

Variante mit 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 

Variante Wörterbuch verwendet erreichen

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

Nun, wenn Sie wollen es nur vereinfachen, können Sie dies tun:

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 

Es diesmal nicht notwendig sein kann, aber wie Sie sagten, Sie wollten Für eine pädagogische Übung könnten Sie eine Prozedur erstellen, nur um Zellenwerte von einem zum anderen zu kopieren. Es könnte wie folgt aussehen:

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

Und Sie würden es so nennen:

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

Oder alternativelly, wenn man wollte Extra klar sein, wie folgt aus:

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

Answer 3

Try dies:

 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

Eine Möglichkeit

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