Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
560to564
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
560to564
560to564
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Nummern aus mehreren Blättern übernehmen

Nummern aus mehreren Blättern übernehmen
08.02.2005 10:35:13
Gerhard
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
AW: Nummern aus mehreren Blättern übernehmen
Beni
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

AW: Nummern aus mehreren Blättern übernehmen
Gerhard
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
Anzeige
AW: Nummern aus mehreren Blättern übernehmen
Gerhard
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
AW: Nummern aus mehreren Blättern übernehmen
Beni
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

Anzeige
AW: Nummern aus mehreren Blättern übernehmen
Gerhard
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
AW: Nummern aus mehreren Blättern übernehmen
Beni
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

Anzeige
AW: Nummern aus mehreren Blättern übernehmen
Gerhard
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
Anzeige
AW: Nummern aus mehreren Blättern übernehmen
Beni
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

AW: Nummern aus mehreren Blättern übernehmen
Gerhard
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
Anzeige
AW: Nummern aus mehreren Blättern übernehmen
Beni
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

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige