makro zellen auslesen

Hallo
mit diesem makro übertrage ich daten von einer tabelle in eine andere tabelle.
es sind insgesamt 118 zeilen die ausgelesen werden müssen.mit diesem makro ist es ein riesen aufwand.
die anordnung der einträge in tabelle drei soll beibehalten werden.
vielleicht hat jemand eine idee für ein besseres makro
mfg rolf


Private Sub Commandbutton2_Click()
' Zeile 3
Sheets("Tabelle3").[B8] = Sheets("Pferdebestand").[A3]
Sheets("Tabelle3").[B9] = Sheets("Pferdebestand").[B3]
Sheets("Tabelle3").[B10] = Sheets("Pferdebestand").[E3]
Sheets("Tabelle3").[B11] = Sheets("Pferdebestand").[F3]
Sheets("Tabelle3").[B12] = Sheets("Pferdebestand").[AG3]
Sheets("Tabelle3").[B13] = Sheets("Pferdebestand").[AH3]
Sheets("Tabelle3").[B14] = Sheets("Pferdebestand").[D3]
Sheets("Tabelle3").[C5] = Sheets("Pferdebestand").[G3]
Sheets("Tabelle3").[C13] = Sheets("Pferdebestand").[J3]
Sheets("Tabelle3").[D3] = Sheets("Pferdebestand").[H3]
Sheets("Tabelle3").[D7] = Sheets("Pferdebestand").[I3]
Sheets("Tabelle3").[D11] = Sheets("Pferdebestand").[K3]
Sheets("Tabelle3").[D15] = Sheets("Pferdebestand").[AJ3]
Sheets("Tabelle3").[E2] = Sheets("Pferdebestand").[AK3]
Sheets("Tabelle3").[E4] = Sheets("Pferdebestand").[AL3]
Sheets("Tabelle3").[E6] = Sheets("Pferdebestand").[AM3]
Sheets("Tabelle3").[E8] = Sheets("Pferdebestand").[AN3]
Sheets("Tabelle3").[E10] = Sheets("Pferdebestand").[AO3]
Sheets("Tabelle3").[E12] = Sheets("Pferdebestand").[AP3]
Sheets("Tabelle3").[E14] = Sheets("Pferdebestand").[AQ3]
Sheets("Tabelle3").[E16] = Sheets("Pferdebestand").[AR3]
'Zeile 4
Sheets("Tabelle3").[B25] = Sheets("Pferdebestand").[A4]
Sheets("Tabelle3").[B26] = Sheets("Pferdebestand").[B4]
Sheets("Tabelle3").[B27] = Sheets("Pferdebestand").[E4]
Sheets("Tabelle3").[B28] = Sheets("Pferdebestand").[F4]
Sheets("Tabelle3").[B29] = Sheets("Pferdebestand").[AG4]
Sheets("Tabelle3").[B30] = Sheets("Pferdebestand").[AH4]
Sheets("Tabelle3").[B31] = Sheets("Pferdebestand").[D4]
Sheets("Tabelle3").[C22] = Sheets("Pferdebestand").[G4]
Sheets("Tabelle3").[C30] = Sheets("Pferdebestand").[J4]
Sheets("Tabelle3").[D20] = Sheets("Pferdebestand").[H4]
Sheets("Tabelle3").[D24] = Sheets("Pferdebestand").[AI4]
Sheets("Tabelle3").[D28] = Sheets("Pferdebestand").[K4]
Sheets("Tabelle3").[D32] = Sheets("Pferdebestand").[AJ4]
Sheets("Tabelle3").[E19] = Sheets("Pferdebestand").[AK4]
Sheets("Tabelle3").[E21] = Sheets("Pferdebestand").[AL4]
Sheets("Tabelle3").[E23] = Sheets("Pferdebestand").[AM4]
Sheets("Tabelle3").[E25] = Sheets("Pferdebestand").[AN4]
Sheets("Tabelle3").[E27] = Sheets("Pferdebestand").[AO4]
Sheets("Tabelle3").[E29] = Sheets("Pferdebestand").[AP4]
Sheets("Tabelle3").[E31] = Sheets("Pferdebestand").[AQ4]
Sheets("Tabelle3").[E33] = Sheets("Pferdebestand").[AR4]
End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Rolf,
ich habe das Makro malein wenig zusammengefasst :

Private Sub Commandbutton2_Click()

    Dim wsZiel As Worksheet, wsQuelle As Worksheet

    Dim arrZellen, strZiel As String, strQuelle As String

    Dim intElement As Integer

    Set wsQuelle = Sheets("Pferdebestand")  'Name des Quellblattes

    Set wsZiel = Sheets("Tabelle3")         'Name des Zielblattes

    'Definition der Zellen : "B8=A3"  bedeutet, dass Zelle A3 nach B8 kopiert wird

    arrZellen = Array("B8=A3", "B9=B3", "B10=E3", "B11=F3", "B12=AG3", _

        "B13=AH3", "B14=D3", "C5=G3", "C13=J3", "D3=H3", "D7=I3", "D11=K3", _

        "D15=AJ3", "E2=AK3", "E4=AL3", "E6=AM3", "E8=AN3", "E10=AO3", "E12=AP3", _

        "E14=AQ3", "E16=AR3", "B25=A4", "B26=B4", "B27=E4", "B28=F4", _

        "B29=AG4", "B30=AH4", "B31=D4", "C22=G4", "C30=J4", "D20=H4", "D24=AI4", _

        "D28=K4", "D32=AJ4", "E19=AK4", "E21=AL4", "E23=AM4", "E25=AN4", _

        "E27=AO4", "E29=AP4", "E31=AQ4", "E33=AR4")

    For intElement = LBound(arrZellen) To UBound(arrZellen)

        strZiel = Split(arrZellen(intElement), "=")(0)    'Quelle VOR dem "=" Zeichen

        strQuelle = Split(arrZellen(intElement), "=")(1)  'Quelle HINTER dem "=" Zeichen

        wsZiel.Range(strZiel) = wsQuelle.Range(strQuelle) 'Quelle nach ZIEL übertragen

    Next

    'Speicher für Objektvariablen inumgekehrter Reihenfolge wieder freigeben :

    Set wsZiel = Nothing

    Setwsquelle = Nothing

End Sub

Die relevanten Zelladressen werden zunächst in einer ARRAY-Variablen gespeichert. Die Adresse VOR dem =-Zeichen ist die ZIEL-Adresse des ZIEL-Blattes, die Adresse hinter dem =-Zeichen ist die QUELL-Adresse des QUELL-Blattes aus dem die Werte übertragen werden.

Den Namen des Quell- und des Ziel-Blattes kannst Du einmalig zu Beginn des Makros festlegen !

Ich hoffe mal, das Makro entspricht Deinen Vorstellungen ;-)

Gruß, NoNet

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

makro zellen auslesen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread