Nummern aus mehreren Blättern übernehmen

Bild

Betrifft: Nummern aus mehreren Blättern übernehmen von: Gerhard
Geschrieben am: 08.02.2005 10:35:13

Hallo
Wie kann ich via VBA aus mehreren Tabellenblättern (es kommen ständig neue hinzu) jeweils die anlaufenden Seriennummern, die in den Bereichen jeweils in jedem Tabellenblatt von T7-T21 und von T28-T42 liegen ohne Leerzeilen (es werden nur gute Teile mit Nummern vergeben und somit Lehrzellen können Lehrzellen entstehen) in ein Übersichtsblatt "Seriennummer" übertragen?
Desweitern sollte in der Übersicht der Tabellenblattname nach unterem Muster übertragen sowie die ChargenNr. die jeweils im Blatt im Bereich B2 steht.

Blattname: ChargenNr. SerienNr.
KW01 Charge:# 0100
0101
0102
0103
usw.
KW02 Charge:# 0104
0105
0106
0107
usw.
KW03 Charge:# 0108
0109
0110
usw.


Danke
Gerhard

Bild


Betrifft: AW: Nummern aus mehreren Blättern übernehmen von: Beni
Geschrieben am: 08.02.2005 11:51:26

Hallo Gerhard,
Gruss Beni



Sub Gerhard()
For sh = 1 To Sheets.Count
    If Left(Sheets(sh).Name, 2) = "KW" Then
        For i = 7 To 42
        If i = 22 Then i = 28
        lz = Sheets("Seriennummer").Cells(Rows.Count, 1).End(xlUp).Row + 1
        Sheets("Seriennummer").Cells(lz, 1) = Sheets(sh).Cells(i, 20)
        Next i
    End If
Next sh
End Sub



Bild


Betrifft: AW: Nummern aus mehreren Blättern übernehmen von: Gerhard
Geschrieben am: 08.02.2005 14:05:18

Hallo
funktioniert soweit!
Wie wird aber in erster Spalte "A" noch der dazugehörige Blattname dargestellt sowie eine Chargen Nr. die immer in Zelle B2 steht?
Beispiel:
Blattname: ChargenNr. Seriennummer

Vielen Dank


Bild


Betrifft: AW: Nummern aus mehreren Blättern übernehmen von: Gerhard
Geschrieben am: 08.02.2005 15:35:04

Hallo
Bei opbigem Programm werden auch Zellen übernommen wo keine SerienNr vergeben wird.
Wie kann ich nur die Zellen die mit einer SerienNr vesehen ist in die Übersicht Seriennummer übernehmen ohne Leerzellen?

Gruß
Gerhard


Bild


Betrifft: AW: Nummern aus mehreren Blättern übernehmen von: Beni
Geschrieben am: 08.02.2005 16:10:52

Hallo Gerhard,
Gruss Beni


Sub Gerhard()
For sh = 1 To Sheets.Count
    If Left(Sheets(sh).Name, 2) = "KW" Then
        For i = 7 To 42
        If i = 22 Then i = 28
        lz = Sheets("Seriennummer").Cells(Rows.Count, 1).End(xlUp).Row + 1
        If Not IsEmpty(Sheets(sh).Cells(i, 20)) Then
        Sheets("Seriennummer").Cells(lz, 1) = Sheets(sh).Cells(2, 2) & " " & Sheets(sh).Cells(i, 20)
        End If
        Next i
    End If
Next sh
End Sub



Bild


Betrifft: AW: Nummern aus mehreren Blättern übernehmen von: Gerhard
Geschrieben am: 08.02.2005 16:40:42

Hallo
Das Makro schreibt jetzt die ChargenNr. und die SerienNr. in eine Zelle.
In erster Spalte "A-Spalte" sollte 1x stehen der Blattname in zweiter Spalte "B-Spalte" sollte 1x die ChargenNr. und in dritter Spalte "C-Spalte" sollten alle SerienNr. ohne Leerzellen augelistet werden (es kann vorkommen, daß einzelne Zellen keine SerienNr.
bekommen) also nur Zellen in Übersicht übernehmen mit einer vorh. SN!!!

Gruß
Gerhard


Bild


Betrifft: AW: Nummern aus mehreren Blättern übernehmen von: Beni
Geschrieben am: 08.02.2005 19:49:57

Hallo Gerhard,
Gruss Beni




Sub Gerhard()
With Sheets("Seriennummer")
For sh = 1 To Sheets.Count
    If Left(Sheets(sh).Name, 2) = "KW" Then
        lz = .Cells(Rows.Count, 3).End(xlUp).Row + 1
        If .Cells(1, 3) = "" Then lz = 1
        .Cells(lz, 1) = Sheets(sh).Name
        .Cells(lz, 2) = Sheets(sh).Cells(2, 2)
        For i = 7 To 42
        If i = 22 Then i = 28
        lz = .Cells(Rows.Count, 3).End(xlUp).Row + 1
        If Not IsEmpty(Sheets(sh).Cells(i, 20)) Then
        .Cells(lz, 3) = Sheets(sh).Cells(i, 20)
        End If
        Next i
    End If
Next sh
End With
End Sub



Bild


Betrifft: AW: Nummern aus mehreren Blättern übernehmen von: Gerhard
Geschrieben am: 08.02.2005 21:16:32

Hallo
Es funktioniert einfach nicht?
Das Programm bringt in Zelle A1 nur den letzten Tabellenblattnamen
in Zelle B1 nur die letzte Charge und ab Zelle C5 mit vielen Leerzeilen
die Seriennummern?
Es sollte so sein, daß alle Tabellenblattnamen angezeigt werden in Spalte A
in Spalte B alle Chargennummern und in Spalte C die Seriennummern ohne Leerzeilen
es können in den einzelnen Blättern wie gesagt Leerzellen vorkommen in denen keine Nummern vergeben werden, weil diese Teile außer Toleranz sind.In der Übersicht sollen die Seriennummern ohne Leerzeilen dargestellt werden.

Gruß
Gerhard


Bild


Betrifft: AW: Nummern aus mehreren Blättern übernehmen von: Beni
Geschrieben am: 09.02.2005 15:55:08

Hallo Gerhard,
es hatte einen Fehler drinn, habs getestet.
Gruss Beni




Sub Gerhard()
With Sheets("Seriennummer")
For sh = 1 To Sheets.Count
    If Left(Sheets(sh).Name, 2) = "KW" Then
        For i = 7 To 42
        If i = 22 Then i = 28
        lz = .Cells(Rows.Count, 3).End(xlUp).Row + 1
        If .Cells(1, 3) = "" Then lz = 1
        If Not IsEmpty(Sheets(sh).Cells(i, 20)) Then
        .Cells(lz, 1) = Sheets(sh).Name
        .Cells(lz, 2) = Sheets(sh).Cells(2, 2)
        .Cells(lz, 3) = Sheets(sh).Cells(i, 20)
        End If
        Next i
    End If
Next sh
End With
End Sub



Bild


Betrifft: AW: Nummern aus mehreren Blättern übernehmen von: Gerhard
Geschrieben am: 09.02.2005 17:24:32

Hallo Beni
Vielen Dank für Deine Mühe
langsam kommen wir dahin wo ich gerne hin möchte!

das Makro funktioniert soweit nur mit folgenden Einschränkungen:
Ich möchte gerne,daß die übertragenen Werte nicht in Zelle A1, B1 und C1 anfangen, sondern erst in den Zellen A5, B5 und C5.
d.h.
ab Zelle A5 Blattname
ab Zelle B5 ChargenNr.
ab Zelle C5 Seriennummern

2. Leider werden in die Übersicht auch die Leerzellen der einzelnen Blättern in denen keine Seriennummern verwendet werden übernommen!
Kann in der Übersicht die Darstellung oder die Übertragung der Seriennummern nicht lückenlos stattfinden.

Gruß
Gerhard


Bild


Betrifft: AW: Nummern aus mehreren Blättern übernehmen von: Beni
Geschrieben am: 09.02.2005 19:32:22

Hallo Gerhard,
bei mir werden keine leeren Zellen übertragen, If Not IsEmpty heist, ist nicht leer,
da reicht schon ein Leerzeichen.
Gruss Beni




Sub Gerhard()
With Sheets("Seriennummer")
For sh = 1 To Sheets.Count
    If Left(Sheets(sh).Name, 2) = "KW" Then
        For i = 7 To 42
        If i = 22 Then i = 28
        lz = .Cells(Rows.Count, 3).End(xlUp).Row + 1
        If .Cells(5, 3) = "" Then lz = 5
        If Not IsEmpty(Sheets(sh).Cells(i, 20)) Then
        .Cells(lz, 1) = Sheets(sh).Name
        .Cells(lz, 2) = Sheets(sh).Cells(2, 2)
        .Cells(lz, 3) = Sheets(sh).Cells(i, 20)
        End If
        Next i
    End If
Next sh
End With
End Sub



 Bild

Beiträge aus den Excel-Beispielen zum Thema "Nummern aus mehreren Blättern übernehmen"