Clever-Excel-Forum - Excel VBA: Spalten in bestimmter Reihenfolge einfügen

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

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

Sortieren kann man am einfachsten im Arbetisblatt, nich bevor.

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

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

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