Excel VBA: Spalten in bestimmter Reihenfolge einfügen

[Schumi]

Hallo zusammen,

ich habe ein Makro aufgezeichnet, das grundsätzlich sehr gut funktioniert. Meine Frage wäre nur, ob sich der Code vereinfachen/verkürzen lässt.

Aus der Quelltabelle (Einsatzdetailreport) sollen Daten von diversen Spalten ab Zeile 2 bis letzte befüllte Zeile kopiert und als Werte in eine andere Tabelle (RE-Eingang) eingefügt werden. Die Reihenfolge der Spaltenanordnung in der Zieltabelle entspricht nicht der Quelltabelle. Dies ist der aktuelle Code aus der Makro-Aufzeichnung:

Code:

Sub DatenKopieren()
'
' DatenKopieren Makro
'

'
    Sheets("Einsatzdetailreport").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("RE-Eingang").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Einsatzdetailreport").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("RE-Eingang").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Einsatzdetailreport").Select
    Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("RE-Eingang").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Einsatzdetailreport").Select
    Range("BD2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("RE-Eingang").Select
    Range("D3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Einsatzdetailreport").Select
    Range("BC2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("RE-Eingang").Select
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Einsatzdetailreport").Select
    Range("N2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("RE-Eingang").Select
    Range("F3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Einsatzdetailreport").Select
    Range("R2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("RE-Eingang").Select
    Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Einsatzdetailreport").Select
    Range("Q2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("RE-Eingang").Select
    Range("H3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Einsatzdetailreport").Select
    Range("T2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("RE-Eingang").Select
    Range("I3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Einsatzdetailreport").Select
    Range("V2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("RE-Eingang").Select
    Range("J3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1").Select
End Sub

Vielen Dank schonmal für Eure Unterstützung.

LG Schumi

[Fennek]

Hallo,

vermutlich möchte sich niemand durch den Rekorder-Code wühlen. Wie wäre es mit einer Tabelle:

Quelle Ziel
A F
B Z
C A

usw.

mfg

[snb]

Sortieren kann man am einfachsten im Arbetisblatt, nich bevor.

[Schumi]

Hallo Fennek,

vielen Dank für Deine Rückmeldung. Hier die gewünschte Gegenüberstellung:

Zieltabelle | Quelltabelle
A3 | B2.xlDown
B3 | A2.xlDown
C3 | E2.xlDown
D3 | BD2.xlDown
E3 | BC2.xlDown
F3 | N2.xlDown
G3 | R2.xlDown
H3 | Q2.xlDown
I3 | T2.xlDown
J3 | V2.xlDown

Ich hoffe, das ist jetzt etwas übersichtlicher als im Code

[Fennek]

Hallo,

teste mal mit

Code:

Sub T_2()
Const Ar As String = "A3|B2|B3|A2|C3|E2|D3|BD2|E3|BC2|F3|N2|G3|R2|H3|Q2|I3|T2|J3|V2|"

Dim Qu As Worksheet: Set Qu = Sheets("Einsatzdetailreport")
Dim Zi As Worksheet: Set Zi = Sheets("Re-Eingang")
Dim rng As Range

icol = Split(Ar, "|")
With Qu
For j = 1 To 10
    .Range(.Cells(3, j), .Cells(Rows.Count, j).End(xlUp)).Copy Zi.Range(icol((j - 1) * 2 + 1))
Next j
End With
End Sub

Falls die Systematik doch anderst sein sollte, der Code ist leicht anzupassen.

mfg

[Schumi]

Hallo Fennek,

die kopierten Daten werden noch nicht an der richtigen Stelle in der Zieltabelle eingefügt. Vielleicht lag es auch an meiner unklaren Gegenüberstellung.

Beispiel:

• Die Daten der Quelltabelle (Einsatzdetailreport) B2 bis letzte befüllte Zeile der Spalte B kopieren und die Werte in Zelle A3 der Zieltabelle (RE-Eingang) einfügen.
  
• Die Daten der Quelltabelle (Einsatzdetailreport) A2 bis letzte befüllte Zeile der Spalte A kopieren und die Werte in Zelle B3 der Zieltabelle (RE-Eingang) einfügen.
  
• Die Daten der Quelltabelle (Einsatzdetailreport) E2 bis letzte befüllte Zeile der Spalte E kopieren und die Werte in Zelle C3 der Zieltabelle (RE-Eingang) einfügen.
  
• usw.
  

Ich wäre Dir sehr dankbar, wenn Du Deinen Code hier nochmal nachjustieren könntest. Herzlichen Dank!

LG Schumi

[Fennek]

Code:

Sub T_3()
Const Ar As String = "A3|B2|B3|A2|C3|E2|D3|BD2|E3|BC2|F3|N2|G3|R2|H3|Q2|I3|T2|J3|V2|"

Dim Qu As Worksheet: Set Qu = Sheets("Einsatzdetailreport")
Dim Zi As Worksheet: Set Zi = Sheets("Re-Eingang")
Dim rng As Range

icol = Split(Ar, "|")
With Qu
For j = 1 To 10
    .Range(.Cells(3, j), .Cells(Rows.Count, j).End(xlUp)).Copy
    Zi.Range(icol((j - 1) * 2 + 1)).PasteSpecial xlPasteValues
Next j
End With
End Sub