Spalteninhalte auslesen u. in neue Tab. schreiben

Liebe Excelcracks
Ich habe folgendes Problem:
Ich habe eine Exceldatei mit ca. 160 Tabellenblättern. Aus jedem Tabellenblatt brauche ich die Eintragungen aus den Spalten B, C, D und E. Diese sollen untereinander in einem neuen Tabellenblatt aufgelistet werden. Hier das Beispiel mal mit 2 Tabellenblättern:
Es kann auch vorkommen, dass Leerzeilen zwischen den einzelnen Zeilen mit Eintragungen sind.
Tabellenblatt_1
Artikel Nr. (Spalte B) Einheit (Spalte C) Bezeichnung (Spalte D) Preis (Spalte E)
123456 1 Pak. Testkleber 100.00
111111 1 Stk. Testpinsel 2.00
Tabellenblatt_2
Artikel Nr. (Spalte B) Einheit (Spalte C) Bezeichnung (Spalte D) Preis (Spalte E)
222222 1 Karton Testetiketten 50.00
333333 1 Bund Testschlüssel 20.00
444444 1 Stk. Testantenne 900.00
Ausgabe im neuen Tabellenblatt
Artikel Nr. (Spalte B) Einheit (Spalte C) Bezeichnung (Spalte D) Preis (Spalte E)
123456 1 Pak. Testkleber 100.00
111111 1 Stk. Testpinsel 2.00
222222 1 Karton Testetiketten 50.00
333333 1 Bund Testschlüssel 20.00
444444 1 Stk. Testantenne 900.00
Für Eure Hilfe danke ich Euch bestens.
Lieber Gruss
Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Peter,
hier ein entsprechendes Makro. Das neue Tabellenblatt wird in einer neuen datei angelegt.
Gruß
Franz

Sub Daten_aus_allen_Blaettern()
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim Zeile_Q As Long, Zeile_Z As Long
Set wbQuelle = ActiveWorkbook
Set wbZiel = Workbooks.Add(Template:=xlWBATWorksheet)
Set wksZiel = wbZiel.Worksheets(1)
With wksZiel
Zeile_Z = 1
.Cells(Zeile_Z, 2).Value = "Artikel Nr."
.Cells(Zeile_Z, 3).Value = "Einheit"
.Cells(Zeile_Z, 4).Value = "Bezeichnung"
.Cells(Zeile_Z, 5).Value = "Preis"
End With
Application.ScreenUpdating = False
For Each wksQuelle In wbQuelle.Worksheets
With wksQuelle
For Zeile_Q = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
If IsEmpty(.Cells(Zeile_Q, 2)) = False Then
Zeile_Z = Zeile_Z + 1
wksZiel.Cells(Zeile_Z, 2).Value = .Cells(Zeile_Q, 2).Value
wksZiel.Cells(Zeile_Z, 3).Value = .Cells(Zeile_Q, 3).Value
wksZiel.Cells(Zeile_Z, 4).Value = .Cells(Zeile_Q, 4).Value
wksZiel.Cells(Zeile_Z, 5).Value = .Cells(Zeile_Q, 5).Value
End If
Next Zeile_Q
End With
Next wksQuelle
Application.ScreenUpdating = True
MsgBox "Fertig"
End Sub

Beliebteste Forumthreads (12 Monate)

Spalteninhalte auslesen u. in neue Tab. schreiben

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalteninhalte auslesen u. in neue Tab. schreiben

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread