Zeilen kopieren

[Andyle]

Ich habe 56 identische Tabellenblätter  mit Zeilen von A3:N33

Diese Daten, will ich in ein Zentrales Tabellenblatt als Jahresübersicht kopieren um daraus eine pdf zu erstellen.

Code:

Code:

Sub zellkopie()

Dim lngLetzte As Long

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row

If lngLetzte = "1" Then
Sheets("Jahresübersicht").Cells(lngLetzte + 1, 1).Value = "KW 1_NJ " & Sheets("Übersicht").Range("E1").Value 'Jahr
Sheets("Jahresübersicht").Range("A2").Font.Color = vbRed
End If

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 2

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "Auftragsnummer:" 'Auftragsnummer
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = Sheets("1_NJ").Range("B3").Value
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Font.Color = vbBlue

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Datum:" 'Datum   Format((Sheets("1_NJ").Range("A2").Value), "dd.mm.yyyy")
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = Format((Sheets("1_NJ").Range("A3").Value), "dd.mm.yyyy")

Sheets("Jahresübersicht").Cells(lngLetzte, 7).Value = "Destination:" 'Land
Sheets("Jahresübersicht").Cells(lngLetzte, 8).Value = Sheets("1_NJ").Range("C3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 10).Value = "Produkt:" 'Produkt
Sheets("Jahresübersicht").Cells(lngLetzte, 11).Value = Sheets("1_NJ").Range("D3").Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1 '2. Zeile

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "Menge:" 'Menge
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = Sheets("1_NJ").Range("E3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Charge:" 'Charge
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = Sheets("1_NJ").Range("F3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 7).Value = "Fremd/Pentol:" 'Fremd/Pentol
Sheets("Jahresübersicht").Cells(lngLetzte, 8).Value = Sheets("1_NJ").Range("G3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 10).Value = "LKW Fremd:" 'LKW Fremd
Sheets("Jahresübersicht").Cells(lngLetzte, 11).Value = Sheets("1_NJ").Range("H3").Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1 '3. Zeile

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "Containernummer:" 'Containernummer
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = Sheets("1_NJ").Range("I3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Plombennummer:" 'Plombennummer
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = Sheets("1_NJ").Range("J3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 7).Value = "Zollplombe:" 'Zollplombe
Sheets("Jahresübersicht").Cells(lngLetzte, 8).Value = Sheets("1_NJ").Range("K3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 10).Value = "Schiff:" 'Schiff
Sheets("Jahresübersicht").Cells(lngLetzte, 11).Value = Sheets("1_NJ").Range("L3").Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1 '4. Zeile

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "ETA:" 'ETA
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = Sheets("1_NJ").Range("M3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Status:" 'Status
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = Sheets("1_NJ").Range("N3").Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1

Sheets("Jahresübersicht").Range("A2:N2000").HorizontalAlignment = xlLeft 'Zellenausrichtung

End Sub

Wie kann ich die Sache automatisieren, dass er von Zeile zu Zeile automatisch kopiert

und danach das nächste Tabellenblatt anfängt zu kopieren?
Die Anordnung müsste allerdings von einer Zeile auf 4 zeilen bestehen bleiben, um es in A4 darstellen zu können!

Danke für Eure Hilfe

[schauan]

Hallöchen,

1)
also, Du kannst eine Schleife über mehrere Blätter anlegen:

...
Dim wshBlatt as Worksheet
...

For Each wshBlatt in Worksheets
'... Deine Aktionen
Next

und bei den Aktionen z.B. statt
...Sheets("1_NJ").Range("B3").Value
dann
...wshBlatt.Range("B3").Value

Eventuell noch mit
If wshBlatt.Name <> "Übersicht" and wshBlatt.Name <> "Jahresübersicht" Then
oder anders die Blattverarbeitung einschränken.

2)
Ich würde die kompletten Bereiche aller Blätter kopieren und einfügen und erst am Ende Spalten einfügen und die Bezeichnungen setzen. Da brauchst Du das nicht für jede Zelle einzeln tun.

3)
man könnte die Daten natürlich auch ohne Makro mit PQ zusammenfassen, Spalten einfügen usw.

[Andyle]

Erstmal vielen Dank @Schauan

Mein jetziger Code:

Code:

Sub zellkopie()

Dim wshBlatt As Worksheet '
Dim lngLetzte As Long

For Each wshBlatt In Worksheets '

If wshBlatt.Name <> "Startseite" And wshBlatt.Name <> "Übersicht" And wshBlatt.Name <> "Aufträge" And wshBlatt.Name <> "Statistik Gefahrgut" And wshBlatt.Name <> "Statistik LKW" And wshBlatt.Name <> "Statistik Tankzug" And wshBlatt.Name <> "Statistik Container" And wshBlatt.Name <> "Einstellungen" And wshBlatt.Name <> "Benutzer" And wshBlatt.Name <> "Backupverwaltung" And wshBlatt.Name <> "History" And wshBlatt.Name <> "Hilfebibliotek" And wshBlatt.Name <> "Hilfstabelle" And wshBlatt.Name <> "Nachrichten" And wshBlatt.Name <> "Updates" And wshBlatt.Name <> "Jahresübersicht" Then

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row

If lngLetzte = "1" Then
Sheets("Jahresübersicht").Cells(lngLetzte + 1, 1).Value = "KW " & wshBlatt.Range("B1") & " " & Sheets("Übersicht").Range("E1").Value 'Jahr
Sheets("Jahresübersicht").Range("A2").Font.Color = vbRed
End If

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 2

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "Auftragsnummer:" 'Auftragsnummer
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = wshBlatt.Range("B3").Value
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Font.Color = vbBlue

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Datum:" 'Datum   Format((Sheets("1_NJ").Range("A2").Value), "dd.mm.yyyy")
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = Format((wshBlatt.Range("A3").Value), "dd.mm.yyyy")

Sheets("Jahresübersicht").Cells(lngLetzte, 7).Value = "Destination:" 'Land
Sheets("Jahresübersicht").Cells(lngLetzte, 8).Value = wshBlatt.Range("C3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 10).Value = "Produkt:" 'Produkt
Sheets("Jahresübersicht").Cells(lngLetzte, 11).Value = wshBlatt.Range("D3").Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1 '2. Zeile

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "Menge:" 'Menge
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = wshBlatt.Range("E3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Charge:" 'Charge
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = wshBlatt.Range("F3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 7).Value = "Fremd/Pentol:" 'Fremd/Pentol
Sheets("Jahresübersicht").Cells(lngLetzte, 8).Value = wshBlatt.Range("G3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 10).Value = "LKW Fremd:" 'LKW Fremd
Sheets("Jahresübersicht").Cells(lngLetzte, 11).Value = wshBlatt.Range("H3").Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1 '3. Zeile

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "Containernummer:" 'Containernummer
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = wshBlatt.Range("I3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Plombennummer:" 'Plombennummer
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = wshBlatt.Range("J3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 7).Value = "Zollplombe:" 'Zollplombe
Sheets("Jahresübersicht").Cells(lngLetzte, 8).Value = wshBlatt.Range("K3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 10).Value = "Schiff:" 'Schiff
Sheets("Jahresübersicht").Cells(lngLetzte, 11).Value = wshBlatt.Range("L3").Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1 '4. Zeile

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "ETA:" 'ETA
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = wshBlatt.Range("M3").Value

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Status:" 'Status
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = wshBlatt.Range("N3").Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1

End If

Next

Sheets("Jahresübersicht").Range("A2:N2000").HorizontalAlignment = xlLeft 'Zellenausrichtung

End Sub

Irgendwie müsste ich den Code noch anpassen!

1. Müsste so funktionieren, sobald er ein neues Blatt einließt, Blattname schreiben.
If lngLetzte = "1" Then
Sheets("Jahresübersicht").Cells(lngLetzte + 1, 1).Value = "KW " & wshBlatt.Range("B1") & " " & Sheets("Übersicht").Range("E1").Value 'Jahr
Sheets("Jahresübersicht").Range("A2").Font.Color = vbRed
End If

2. Jetzt ließt er ja nur immer die erste Zeile (A3 bis N3)
Wie kann ich es machen, dass er alle Zeilen ließt, die mit Daten gefüllt sind?

Es sind nicht immer alle Zeilen in den KW-Blättern gefüllt!

[Klaus-Dieter]

Hallo,

ohne deine Datei ist das nur stochern im Nebel.

[Andyle]

@ Klaus-Dieter

Das mag schon sein, aber ich habe mir mal hier kommentare von Dir angesehen, die immer wieder das gleiche Schema haben.

Kritik, die Leute dumm hinstellen, aber nicht wirklich ein Weg finden den Leuten konstruktiv zu helfen.

Hast Du keine konstruktiven Vorschläge, dann solltest Du dir lieber Deine "Kommentare" sparen.

Andere hier im Forum sind da wenigstens hilfsbereit.

[schauan]

Hallöchen,

ich weiß nicht, warum Du jetzt so gegen Klaus-Dieter schießt. Hier gibt es die unterschiedlichsten Fragesteller und Antworter mit den unterschiedlichsten Charakteren, Ausdrucksweisen usw. und entsprechend wird dann auch geantwortet.
Mit einer wie auch immer formulierten Frage nach einer Beispieldatei wird Dir doch ein Interesse an Hilfestellung signalisiert, alles andere, was Du da heranziehst, findet sich in dieser Antwort nicht.

Die Fragesteller kommen auch häufig von einem Umstand zum nächsten, und auch das ist ein Stochern und zuweilen kann man dann einen Vorschlag nach dem nächsten in die Tonne drücken.

--> Du schreibst am Anfang
Ich habe 56 identische Tabellenblätter mit Zeilen von A3:N33

Da kannst Du ja entsprechend meinem Vorschlag immer diesen Bereich übertragen, z.B. mit Kopieren und Einfügen oder wie auch immer.
Wo, ermittelst Du ja bereits mit lngLetzte - das gehört natürlich an passender Stelle auch in die Schleife.

--> Dann schreibst Du
Es sind nicht immer alle Zeilen in den KW-Blättern gefüllt!
so, also doch nicht immer A3:N33. Auf dem Quellblatt kannst Du aber ebenso die letzte belegte Zelle feststellen, wie auch auf dem Zielblatt. Für die Quelle könntest Du eine zusätzliche Variable verwenden, ja nach Zeitpunkt der Ermittlung musst Du das aber nicht. Das kannst Du dann in der Bereichsangabe verwenden, z.B. Range(A3:N" & lngLetzteQ)

--> Anmerkung: Man kann ggf. trotzdem den kompletten Bereich übertragen. Wenn da nicht gerade Formeln stehen, die leere Zellen erzeugen, und mit übertragen werden, dann findet der code für lngLetzte im Ziel schon die richtige Stelle.

[Andyle]

Die letzte Zeile mit Daten in den KW-Blättern ermittle ich mit:

lngLetztedaten = wshBlatt.Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile mit Daten in den KW-Blättern

Nur wie rutsche ich in die nächte zeile der KW-Blätter wenn erste Zeile übertragen wurde?

Sheets("Jahresübersicht").Cells(lngLetzte, 7).Value = "Destination:" 'Land
Sheets("Jahresübersicht").Cells(lngLetzte, 8).Value = wshBlatt.Range("C3").Value

C3 müsste dann ja C4 (2.Zeile) heisen

[schauan]

Hallöchen,

also, Du musst doch nur nach Abarbeitung einer Zeile nach dem Motto viele Wege führen nach Rom
- lngLetzte um 1 erhöhen
oder
- lngLetzte neu ermitteln
Machst Du doch schon.

Aber ich glaube, Du willst am Anfang der Übernahme eines Blattes die KW usw. eintragen?

Du hast

For Each wshBlatt In Worksheets '

--> Dann kommt die Blatteinschränkung und dann

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row
If lngLetzte = "1" Then
...

If lngLetzte = "1" Then --> brauchst Du nach Wechsel auf ein Blatt nicht, da bist Du am Anfang. Trage also generell hier die Daten ein.
...

dann
lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 2

Anschließend käme aber eine weitere Schleife für Deine Quell-Zeilen 3 bis 33, also z.B.

For iCnt = 3 to 33
... Alle Daten einer Zeile holen
Next

Nimm dann aber besser z.B. statt
wshBlatt.Range("B3").Value
dann
wshBlatt.Range("B" & iCnt).Value
oder arbeite besser mit Cells -->
wshBlatt.Cells(iCnt, 2).Value


Wenn Du eine fixe Zelle überträgst, dann kannst Du da auch die Angabe lassen. Ich weiß nicht, ob Dein Datum eines Blattes z.B. immer aus A2 geholt wird, dann kannst Du da auch fest A2 programmieren.

Das wäre jetzt wieder stochern, ... und das Du aus einer Quell-Zeile mehrere im Ziel machst hatte ich nicht gleich im Code gesehen. Das wäre dann wieder das Thema Beispieldatei --> Wobei ich da eher für Zurückhaltung bin, mal überspitzt - manch einer schickt unaufgefordert für die Formel =A1*B1 eine ...

[Klaus-Dieter]

@ Andyle,

wollte nur helfen, das geht umso besser, je genauer man weiß, worum es geht - wird nicht mehr vorkommen..

[Andyle]

So mein jetziger Code:

Code:

Sub zellkopie()

Dim wshBlatt As Worksheet '
Dim lngLetzte As Long
Dim lngLetztedaten As Long
Dim i As Long

For Each wshBlatt In Worksheets '

lngLetztedaten = wshBlatt.Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile mit Daten in den KW-Blättern
For i = 3 To lngLetztedaten

If wshBlatt.Name <> "Startseite" And wshBlatt.Name <> "Übersicht" And wshBlatt.Name <> "Aufträge" And wshBlatt.Name <> "Statistik Gefahrgut" And wshBlatt.Name <> "Statistik LKW" And wshBlatt.Name <> "Statistik Tankzug" And wshBlatt.Name <> "Statistik Container" And wshBlatt.Name <> "Einstellungen" And wshBlatt.Name <> "Benutzer" And wshBlatt.Name <> "Backupverwaltung" And wshBlatt.Name <> "History" And wshBlatt.Name <> "Hilfebibliotek" And wshBlatt.Name <> "Hilfstabelle" And wshBlatt.Name <> "Nachrichten" And wshBlatt.Name <> "Updates" And wshBlatt.Name <> "Jahresübersicht" Then

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row

'If lngLetzte = "1" Then
lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Jahresübersicht").Cells(lngLetzte + 1, 1).Value = "KW " & wshBlatt.Range("B1") & " " & Sheets("Übersicht").Range("E1").Value 'Jahr
Sheets("Jahresübersicht").Range("A2").Font.Color = vbRed
'End If

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 2

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "Auftragsnummer:" 'Auftragsnummer
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = wshBlatt.Range("B" & i).Value
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Font.Color = vbBlue

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Datum:" 'Datum   Format((Sheets("1_NJ").Range("A2").Value), "dd.mm.yyyy")
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = Format((wshBlatt.Range("A" & i).Value), "dd.mm.yyyy")

Sheets("Jahresübersicht").Cells(lngLetzte, 7).Value = "Destination:" 'Land
Sheets("Jahresübersicht").Cells(lngLetzte, 8).Value = wshBlatt.Range("C" & i).Value

Sheets("Jahresübersicht").Cells(lngLetzte, 10).Value = "Produkt:" 'Produkt
Sheets("Jahresübersicht").Cells(lngLetzte, 11).Value = wshBlatt.Range("D" & i).Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1 '2. Zeile

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "Menge:" 'Menge
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = wshBlatt.Range("E" & i).Value

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Charge:" 'Charge
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = wshBlatt.Range("F" & i).Value

Sheets("Jahresübersicht").Cells(lngLetzte, 7).Value = "Fremd/Pentol:" 'Fremd/Pentol
Sheets("Jahresübersicht").Cells(lngLetzte, 8).Value = wshBlatt.Range("G" & i).Value

Sheets("Jahresübersicht").Cells(lngLetzte, 10).Value = "LKW Fremd:" 'LKW Fremd
Sheets("Jahresübersicht").Cells(lngLetzte, 11).Value = wshBlatt.Range("H" & i).Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1 '3. Zeile

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "Containernummer:" 'Containernummer
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = wshBlatt.Range("I" & i).Value

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Plombennummer:" 'Plombennummer
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = wshBlatt.Range("J" & i).Value

Sheets("Jahresübersicht").Cells(lngLetzte, 7).Value = "Zollplombe:" 'Zollplombe
Sheets("Jahresübersicht").Cells(lngLetzte, 8).Value = wshBlatt.Range("K" & i).Value

Sheets("Jahresübersicht").Cells(lngLetzte, 10).Value = "Schiff:" 'Schiff
Sheets("Jahresübersicht").Cells(lngLetzte, 11).Value = wshBlatt.Range("L" & i).Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1 '4. Zeile

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "ETA:" 'ETA
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = wshBlatt.Range("M" & i).Value

Sheets("Jahresübersicht").Cells(lngLetzte, 4).Value = "Status:" 'Status
Sheets("Jahresübersicht").Cells(lngLetzte, 5).Value = wshBlatt.Range("N" & i).Value

lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1

End If

Next i

Next

Sheets("Jahresübersicht").Range("A2:N2000").HorizontalAlignment = xlLeft 'Zellenausrichtung

End Sub

Alles funzt soweit mit der Übertrageng!

Noch 2 Probleme habe ich:

Code:

'If lngLetzte = "1" Then
lngLetzte = Sheets("Jahresübersicht").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Jahresübersicht").Cells(lngLetzte + 1, 1).Value = "KW " & wshBlatt.Range("B1") & " " & Sheets("Übersicht").Range("E1").Value 'Jahr
Sheets("Jahresübersicht").Range("A2").Font.Color = vbRed
'End If

1. Wie bekomme ich es hin, dass er nicht bei jedem Eintrag dias schreibt, sondern nur wenn ein neues Tabellenblatt gelesen wird?

Bsp.:

KW 1_NJ 2023

Auftrag 1

Auftrag 2

KW 53 2023

Auftrag 1

KW 52 2023

2. Bei diesem Code schreibt er zwar die Auftragsnummer korrekt, aber färbt unterschiedliche Zeilen in der Jahresübersicht.

Code:

Sheets("Jahresübersicht").Cells(lngLetzte, 1).Value = "Auftragsnummer:" 'Auftragsnummer
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Value = wshBlatt.Range("B" & i).Value
Sheets("Jahresübersicht").Cells(lngLetzte, 2).Font.Color = vbBlue

Wie kann ich das anpassen?

Vielen dank für Eure Hilfe!

---

@Klaus-Dieter

Kein Problem.
Mit einer Beispieldatei hast Du ja recht, nur kann ich hier keine geheimen Zolldaten ins Netz stellen.