Übertrag von einem TB in ein anderes TB

12.04.2026 19:03:48

Sabrina

Hallo,

für die Datenübertragung habe ich mir mit Hilfe des Forums/Suchfunktion einen Code zusammengestellt. Es werden Daten von einem in das andere Tabellenblatt übertragen.

Im Reg. Versand werden über einen Button die Daten aus dem Reg. Wochenplan gezogen.

Nun zu meinem Problem:
Die Farben aus dem Reg. Wochenplan werden nicht mit übernommen (bed. Formatierung /Verladetag – Kunden-Namen).
Leider kann ich die bed. Formatierung nicht auch im Reg. Versand anwenden, da dort die Spalte Verladetag nicht vorhanden ist.

Es wird nur die 1. Seite übertragen.
Ich möchte aber, dass alle Daten übertragen werden, bei denen im Wochenplan eine „lfd. Nr.“ (Spalte C) eingetragen ist.

Und richtig klasse wäre, wenn das Format, z.B. der Zeile 7 im Reg. Versand, auf alle eingefügten Zeilen übernommen wird.

Freue mich über jegliche Unterstützung von euch und bedanke mich schon einmal im Voraus.

https://www.herber.de/bbs/user/180527.xlsm

LG Sabrina

@Alwin

13.04.2026 00:59:40

Sabrina

Hallo Uwe,
danke für deine Vorschlag im falschen Thread ;-) - ist mir auch schon mal passiert.

Dein Vorschlag liest ALLE Daten ein, es sollen aber nur die, welche in Sp C (lfd. Nr.) einen Eintrag haben zudem
möchte ich auch gerne die Farben mit übernehmen, falls möglich.

Hast du noch eine Idee? Wäre klasse.

LG Sabrina

Vorschlag nun im richtigen Thread

13.04.2026 01:17:32

Alwin Weisangler

Sorry Sabrina,

da hatte nicht nur in den falschen Thread erwischt sondern auch die Sache falsch verstanden.

Es ist jetzt schon spät, sollte sich da nicht noch ein schlafloser über Nacht mit einem Lösungsvorschlag melden, werde ich dir da Morgen Vormittag mal zusammenstellen.

Gibt es Zusammenhänge zu den Farben, damit sich das vielleicht mit bedingter Formatierung lösen lässt?
Wenn nicht würde ich dies troztdem erst mal via Array aus Effizienzgründen in die Zieltabelle einlesen und im 2. Schritt die Zellen Farbweise in einen String sammeln und da auch on Block Stringlänge 255 Zeichen den Range die jeweilige Farbe verpassen, als durch die Tabelle zu wursten und jede Zelle einzeln die Farbe zu verpassen.

Der Odnung halber hier nochmals der Code an richtiger Stelle:



Sub AllesSchreiben()

    Dim rng As Range, fa$, arrS(), arrE(), arrTab, i&, lz&

    Set rng = Tabelle2.Columns(3).Find(What:="Nr.", LookAt:=xlWhole)

    fa = rng.Address

    Do

        i = i + 1

        ReDim Preserve arrS(1 To i)

        arrS(i) = rng.Row + 1

        Set rng = Tabelle2.Columns(3).FindNext(rng)

        If rng Is Nothing Then Exit Do

    Loop While rng.Address > fa

    i = 0

    

    Set rng = Tabelle2.Columns(11).Find(What:="Blatt:", LookAt:=xlWhole)

    fa = rng.Address

    Do

        i = i + 1

        ReDim Preserve arrE(1 To i)

        arrE(i) = rng.Row - 1

        Set rng = Tabelle2.Columns(11).FindNext(rng)

        If rng Is Nothing Then Exit Do

    Loop While rng.Address > fa

    

    Tabelle5.Range("A7:I2000").ClearContents

    For i = LBound(arrS) To UBound(arrS)

        If i  UBound(arrS) Then

            arrTab = Application.Index(Tabelle2.Range("A" & arrS(i) & ":L" & arrE(i)), Evaluate("row(1:" & arrE(i) - arrS(i) + 1 & ")"), Array(2, 4, 7, 6, 5, 8, 12, 9, 10))

        Else

            lz = Tabelle2.Cells(Rows.Count, 3).End(xlUp).Row

            Erase arrTab

            If lz > arrS(i) Then

                arrTab = Application.Index(Tabelle2.Range("A" & arrS(i) & ":L" & lz), Evaluate("row(1:" & lz - arrS(i) + 1 & ")"), Array(2, 4, 7, 6, 5, 8, 12, 9, 10))

            Else

                Exit Sub

            End If

        End If

        lz = Tabelle5.Cells(Rows.Count, 3).End(xlUp).Row + 1

        Tabelle5.Cells(lz, 1).Resize(UBound(arrTab), UBound(arrTab, 2)) = arrTab

    Next i

End Sub

Gruß Uwe

@Alwin

13.04.2026 01:33:51

Sabrina

Hey, ist ja auch schon spät :-)

Ich habe mir überlegt, die Farben NICHT mit zu übernehmen, da diese abhängig vom Verladetag sind. Bisher wird diese Spalte nicht in den Versand übernommen.
Also werde ich diese Spalte dann doch in den Versand übernehmen, und zwar am Ende der Tabelle und diese dann ausblenden (vorausgesetzt, ich schaffe es, deinen Code dahingehend zu ändern).
Somit kann ich dann einfacher mit der bedingten Formatierung arbeiten.
Farbübertragung ist - glaube ich - eh ein schwieriges Unterfangen.

Danke dir und gute Nacht auch an alle anderen Foristen

LG Sabrina

Frage zu "Nur Zeilen übernehmen mit Nummer in Spalte C"

13.04.2026 10:42:44

Alwin Weisangler

Hallo Sabrina,

wie verhält es sich mit den Nummern in Spalte C:
Gibt es in einem Tabellenblock zwischen vorhandenen Nummern auch offen gelassene Nummern?

Warum frage ich:
Ich will die Sache möglichst schlank halten und unnötige Schleifendurchläufe zu vermeiden um größere Blöcke zurück schreiben zu können.

Gruß Uwe

Lösung Nummern in Spalte C im jeweiligen Block fortlaufend

13.04.2026 10:59:09

Alwin Weisangler

Für den Fall, dass im jeweiligen Tabellenblock im Blatt "Wochenplan" die Nummern fortlaufend sind wie in der Beispieldatei, kann man dies mit .Countif() am effizientesten lösen.

Das wäre so:



Sub AllesSchreiben()

    Dim rng As Range, fa$, arrS(), arrE(), arrTab, i&, lz&, iZ&

    Set rng = Tabelle2.Columns(3).Find(What:="Nr.", LookAt:=xlWhole)

    fa = rng.Address

    Do

        i = i + 1

        ReDim Preserve arrS(1 To i)

        arrS(i) = rng.Row + 1

        Set rng = Tabelle2.Columns(3).FindNext(rng)

        If rng Is Nothing Then Exit Do

    Loop While rng.Address > fa

    i = 0

    

    Set rng = Tabelle2.Columns(11).Find(What:="Blatt:", LookAt:=xlWhole)

    fa = rng.Address

    Do

        i = i + 1

        ReDim Preserve arrE(1 To i)

        arrE(i) = rng.Row - 1

        Set rng = Tabelle2.Columns(11).FindNext(rng)

        If rng Is Nothing Then Exit Do

    Loop While rng.Address > fa

    

    Tabelle5.Range("A7:I2000").ClearContents

    For i = LBound(arrS) To UBound(arrS)

        If i  UBound(arrS) Then

            arrTab = Application.Index(Tabelle2.Range("A" & arrS(i) & ":L" & arrE(i)), Evaluate("row(1:" & arrE(i) - arrS(i) + 1 & ")"), Array(2, 4, 7, 6, 5, 8, 12, 9, 10))

        Else

            lz = Tabelle2.Cells(Rows.Count, 3).End(xlUp).Row

            Erase arrTab

            If lz > arrS(i) Then

                arrTab = Application.Index(Tabelle2.Range("A" & arrS(i) & ":L" & lz), Evaluate("row(1:" & lz - arrS(i) + 1 & ")"), Array(2, 4, 7, 6, 5, 8, 12, 9, 10))

            Else

                Exit Sub

            End If

        End If

        iZ = WorksheetFunction.CountIf(Tabelle2.Range("C" & arrS(i) & ":C" & arrE(i)), ">0")

        lz = Tabelle5.Cells(Rows.Count, 3).End(xlUp).Row + 1

        If iZ > 0 Then Tabelle5.Cells(lz, 1).Resize(iZ, UBound(arrTab, 2)) = arrTab

    Next i

End Sub

Gruß Uwe

Ergänzung

13.04.2026 11:18:07

Alwin Weisangler

ah, ich habe gesehen, dass du im Blatt "Wochenplan" die Spalte A zum Färben in bedingter Formatierung nimmst. Dann musst du nur in Index den Range erweitern und das Spaltenarray anpassen.

so:



Sub AllesSchreiben()

    Dim rng As Range, fa$, arrS(), arrE(), arrTab, i&, lz&, iZ&

    Set rng = Tabelle2.Columns(3).Find(What:="Nr.", LookAt:=xlWhole)

    fa = rng.Address

    Do

        i = i + 1

        ReDim Preserve arrS(1 To i)

        arrS(i) = rng.Row + 1

        Set rng = Tabelle2.Columns(3).FindNext(rng)

        If rng Is Nothing Then Exit Do

    Loop While rng.Address > fa

    i = 0

    

    Set rng = Tabelle2.Columns(11).Find(What:="Blatt:", LookAt:=xlWhole)

    fa = rng.Address

    Do

        i = i + 1

        ReDim Preserve arrE(1 To i)

        arrE(i) = rng.Row - 1

        Set rng = Tabelle2.Columns(11).FindNext(rng)

        If rng Is Nothing Then Exit Do

    Loop While rng.Address > fa

    

    Tabelle5.Range("A7:I2000").ClearContents

    For i = LBound(arrS) To UBound(arrS)

        If i  UBound(arrS) Then

            arrTab = Application.Index(Tabelle2.Range("A" & arrS(i) & ":M" & arrE(i)), Evaluate("row(1:" & arrE(i) - arrS(i) + 1 & ")"), Array(2, 4, 7, 6, 5, 8, 12, 9, 10, 13, 1))

        Else

            lz = Tabelle2.Cells(Rows.Count, 3).End(xlUp).Row

            Erase arrTab

            If lz > arrS(i) Then

                arrTab = Application.Index(Tabelle2.Range("A" & arrS(i) & ":M" & lz), Evaluate("row(1:" & lz - arrS(i) + 1 & ")"), Array(2, 4, 7, 6, 5, 8, 12, 9, 10, 13, 1))

            Else

                Exit Sub

            End If

        End If

        iZ = WorksheetFunction.CountIf(Tabelle2.Range("C" & arrS(i) & ":C" & arrE(i)), ">0")

        lz = Tabelle5.Cells(Rows.Count, 3).End(xlUp).Row + 1

        If iZ > 0 Then Tabelle5.Cells(lz, 1).Resize(iZ, UBound(arrTab, 2)) = arrTab

    Next i

End Sub

Gruß Uwe

Wow :-)

13.04.2026 18:22:56

Sabrina

Hallo Uwe,

ich bin geplättet über so viel Einsatz von dir. Danke schön.

Du hast Recht, die Nummern sind definitiv fortlaufend (ohne leere Zellen dazwischen). Deine wahnsinns Arbeit (Code) kann ich erst gleich probieren.
Bis gleich und nochmals: Danke für deinen tollen Einsatz.

LG Sabrina

klappt ganz gut

13.04.2026 20:36:04

Sabrina

Hallo Uwe,

super, der Verladetag wird ja jetzt mit übertragen, somit kann ich eine bedingte Formatierung erstellen. Prima, vielen Dank.
Auch das Einlesen bis zur letzten vergebenen Nr. funktioniert einwandfrei.

Gibt es denn die Möglichkeit per VBA, beispielsweise das Format der Zeile 7 (Zeilenhöhe /Linien) auf alle gefüllten Zeilen zu übernehmen? Denn auch hier muss ja die letzte gefüllte Zeile gefunden werden. Wäre schon klasse :-)

Danke dir.

LG Sabrina

Problem Rahmen und Zellenhöhe

13.04.2026 22:51:29

Alwin Weisangler

Hallo Sabrina,

Linien kannst du mit bedingter Formatierung setzen. Ausreichend großen Bereich Zeilen z.B.: Zelle A7:J1000 selektieren --> bedingte Formatierung --> Neue Regel --> Formel zur Ermittlung ... --> Formel:=$C7>0 --> Button Formatieren klicken --> Rahmen deiner Wahl einstellen.

Zum Einstellen der Zellenhöhe selektierst du links eine ausreichend große Anzahl Zeilen und ziehst diese mit der Maus auf die gewünschte Zellenhöhe von 21(35px).
Mit VBA ginge das so:



Sub ZeilenhoeheAnpassen()

    Dim zHe&

    With Tabelle5

        zHe = .Cells(7, 3).RowHeight

        .Rows("8:" & .Cells(Rows.Count, 3).End(xlUp).Row).RowHeight = zHe

    End With

End Sub

Ich würde des aber einmalig händisch machen.

Gruß Uwe

Passt alles :-)

13.04.2026 23:15:05

Sabrina

ooohhhh neeeeee - die Lösung liegt sooooo nah!!! Natürlich Uwe, bedingte Formatierung - ja, manchmal steht man auf der eigenen Leitung :-)

Nun eine grundsätzliche Frage: Ich möchte ja die Codes verstehen, um selbst Änderungen vornehmen zu können und auch (wie bei meinem ursprünglichen) hier und da für mich selbst einen Code zusammenzustellen. Dein Code ist ... schwierig .... zu lesen, dennoch werde ich es versuchen. Wenn ich nun eine Frage dazu habe, stelle ich diese dann in diesem Thread? Oder per Mail? Vorausgesetzt natürlich, du hast Lust und Zeit diese zu beantworten.

Vielen lieben Dank noch einmal für deine Unterstützung.

LG Sabrina

Rückmeldung

13.04.2026 23:37:31

Alwin Weisangler

Hallo Sabrina,

stelle so lang dieser Thread aktiv ist deine Frage(n). Selbst wenn ich es mal nicht gleich mitbekomme, gibt es hier etliche Helfer, die dir dazu auch mühelos erklären können was da passiert.

Das was ich dir hinterlassen habe ist auf jeden Fall ein recht effizienter Weg, da in dieser Prozedur Blockweise gelesen und geschrieben wird. Das ist um das ca. 20-fache schneller als irgendwelche Lese- Schreibvorgänge zelle- oder zeilenweise durch die Tabellenblätter.

Was etwas an der Latenz frisst ist die bedingte Formatierung. Die ist doch deutlich volatiler.

Gruß Uwe

Änderung

16.04.2026 15:46:52

Sabrina

Hallo Uwe, ich hoffe, du liest diesen Beitrag noch.

Zuersteinmal: Der Code funktioniert auch im Original.

Allerdings hat sich herausgestellt, dass ich doch 1 Spalte löschen muss, die andere tauschen usw.

Ich probiere das ersteinmal selbst am Wochenende. Sollte ich es nicht hinbekommen, melde ich mich in diesem Thread noch einmal. Ist das ok?

Ich danke dir jetzt schon für deine Unterstützung.

LG Sabrina

AW: Änderung

16.04.2026 15:51:05

Alwin Weisangler

Hallo Sabrina,

in den Zeilen wo dies steht:



Application.Index(Tabelle2.Range("A" & arrS(i) & ":M" & arrE(i)), Evaluate("row(1:" & arrE(i) - arrS(i) + 1 & ")"), Array(2, 4, 7, 6, 5, 8, 12, 9, 10, 13, 1))

sind die Spaltennummern im Array(2, 4, 7, 6, 5, 8, 12, 9, 10, 13, 1) enthalten. Da kannst du dann deine Änderungen vornehmen.

Gruß Uwe

AW: Änderung

17.04.2026 01:58:21

Sabrina

Hallo Uwe,

ja genau, ich konnte die Reihenfolge ändern. Die Spaltenfolge überträgt ja alle Daten NEBENEINANDER. Die Spalte (Notiz) muss leer bleiben.

Also:
Array(2, 4, 6, 7, 8, 12, 9, 10, 1))

Bis Spalte 10 passt der Übertrag, dann muss aber in meinem "Versand" die nächste Spalte leer bleiben (Notiz) und dann kommt die Spalte 1 (als Hilfsspalte).

Leider bekomme ich es nicht hin = 10, lass Spalte leer, 1))

Sorry, habe tatsächlich ewig gegoogelt aber ich kanns einfach nicht :-(

Ich danke dir Uwe, für heute mache ich aber Feierabend :-)

LG Sabrina

AW: Änderung

17.04.2026 10:52:50

Alwin Weisangler

Hallo Sabrina,

um die Ausgabespalte 10 leer zu übertragen muss du dir die nächstliegende leere Spalte aus Tabelle2 als Ziffer ins Array eintragen und natürlich dazu den Range aus Tabelle 2 anpassen.
Wenn du dies nicht anpasst kommt es zu einem Dimensionskonflikt da Evaluate das nicht verarbeiten kann.
Beispiel: leere Spalte im Array Spaltennummer13 bedeutet, dass der Range in Tabelle 2 mindestens bis Spalte 13 (Spalte M) eingelesen werden muss.

Nach diesem Prinzip: Tabelle2.Range("A" & arrS(i) & ":M"
Das Array() gibt Spalte für Spalte zurück. Bsp.: Array(4, 1, 6) 1. Ausgabespalte ist die Spalte D aus Tabelle2 | 2. Ausgabespalte ist die Spalte A aus Tabelle2 3. Ausgabespalte ist die Spalte F aus Tabelle2.

Das ist der Mechanismus dahinter.

Gruß Uwe

AW: Änderung PASST *freu*

17.04.2026 23:46:37

Sabrina

Hallo Uwe,

hab es hingekriegt dank deiner Erklärung. Der Knackpunkt war, dass ich folgenden Zusammenhang nicht verstanden hatte:

...Array Spaltennummer13 bedeutet, dass der Range in Tabelle 2 mindestens bis Spalte 13 (Spalte M) eingelesen ...

Im Zweifelsfall hätte ich eine leere Spalte eingefügt und hier die Nr. für die bedingte Formatierung einlesen lassen, dann ausblenden :-)

Vielen lieben Dank für deine Geduld Uwe - Montag wirds in die Praxis umgesetzt 🙈

Hab einen schönen Abend.

VG Sabrina

Übertrag von einem TB in ein anderes TB

Forumthread: Übertrag von einem TB in ein anderes TB

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Übertrag von einem TB in ein anderes TB

Forumthread: Übertrag von einem TB in ein anderes TB

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread