Erstellen Werkzeugliste aus Tabellenblätter

Hallo,
ich würde gern folgendes Makro programmieren:
Ich habe eine Excel-Datei mit ungefähr 50 Blättern, welche jeweils einen Arbeitsvorgang beschreiben. Die Blätter sind leider nicht einheitlich Formatiert.
Die Blätter beinhalten IRGENDWO die Information
"Werkzeug1" "Anzahl"
"Werkzeug2" "Anzahl"
in zwei Nebeneinander liegenden Zellen.
Jetzt möchte ich eine Übersicht über die benötigten Werkzeuge erstellen.
Bis jetzt bin ich soweit, dass ein Makro eine Übersicht über alle Tabellenblätter erstellt, durchnummeriert und mit einem Link belegt. Daneben möchte ich nun eine Tabelle mit den benötigten Werkzeugen erstellen. In der Headzeile der Tabelle steht also
"Nr." "Tabellenblatt" "Werkzeug1" "Werkzeug2" "Werkzeug3" ,usw
Die weiteren Zeilen sollen dann gefüllt werden mit:
"NameTabellenblatt" "Anzahl_Werkzeug1" "Anzahl Werkzeug2" "Anzahl Werkzeug3", usw.
Das Makro soll also nun alle Tabellenblätter langgehen, und jedes Tabellenblatte auf den Namen der Werkzeuge überprüfen (diesen also mit der Headzeile vergleichen), wenn auf einem Tabellenblatt das Werkzeug gefunden wurde den Wert NEBEN dem Werkzeug, also der Anzahl, übernehmen und in die Übersicht eintragen.
Als I-Tüpfelchen könnte man dann ganz unten die Werkzeuge endlich aufsummieren, aber das würde ich auch einfach dann mit einer Formel machen.
Ich hab ein wenig erfahrung mit erstellen von Makros, aber das ist mir doch eine Nummer zu kompliziert. Ich hoffe ich hab mich verständlich ausgedrückt. Ich kann gerne nochmal versuchen weiteres zu erklären.
Danke

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub henning() Dim rFind As Range, rMatch As Range, lRow Dim wks As Worksheet With Sheets("Übersicht") .Hyperlinks.Delete For Each wks In Worksheets If Not wks Is Sheets("Übersicht") Then For Each rMatch In .Range(.Cells(1, 3), .Cells(1, Columns.Count).End(xlToLeft)) Set rFind = wks.Cells.Find(what:=rMatch, lookat:=xlWhole) If Not rFind Is Nothing Then lRow = Application.Match(wks.Name, .Columns(2), 0) If IsError(lRow) Then lRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row End If .Cells(lRow, 1) = WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(lRow - 1, 1))) + _ 1 .Cells(lRow, 2) = wks.Name .Cells(lRow, rMatch.Column) = rFind.Offset(, 1) .Hyperlinks.Add .Cells(lRow, rMatch.Column), "#'" & wks.Name & "'!" & rFind.Address End If Next rMatch End If Next wks End With End Sub

Sub henning() Dim rFind As Range, rMatch As Range, lRow Dim wks As Worksheet With Sheets("Werkzeugliste") .Hyperlinks.Delete For Each wks In Worksheets If Not wks Is Sheets("Werkzeugliste") Then For Each rMatch In .Range(.Cells(2, 3), .Cells(2, Columns.Count).End(xlToLeft)) Set rFind = wks.Cells.Find(what:=rMatch, lookat:=xlWhole) If Not rFind Is Nothing Then lRow = Application.Match(wks.Name, .Columns(2), 0) If IsError(lRow) Then lRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row End If .Cells(lRow, 1) = _ WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(lRow - 1, 1))) + 1 .Cells(lRow, 2) = wks.Name .Cells(lRow, rMatch.Column) = rFind.Offset(, 1) .Hyperlinks.Add .Cells(lRow, rMatch.Column), "#'" & wks.Name & "'!" & rFind.Address End If Next rMatch End If Next wks End With End Sub

Sub Werkzeugliste() Dim rFind As Range, rMatch As Range, lRow Dim wks As Worksheet With Sheets("Werkzeugliste") .Hyperlinks.Delete For Each wks In Worksheets If Not wks Is Sheets("Werkzeugliste") And _ wks Sheets("Vorlage") And _ wks Sheets("Übersicht") Then For Each rMatch In .Range(.Cells(2, 3), .Cells(2, Columns.Count).End(xlToLeft)) Set rFind = wks.Cells.Find(what:=rMatch, lookat:=xlWhole) If Not rFind Is Nothing Then lRow = Application.Match(wks.Name, .Columns(2), 0) If IsError(lRow) Then lRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row End If .Cells(lRow, 1) = _ WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(lRow - 1, 1))) + 1 .Cells(lRow, 2) = wks.Name .Cells(lRow, rMatch.Column) = rFind.Offset(, 1) .Hyperlinks.Add .Cells(lRow, rMatch.Column), "#'" & wks.Name & "'!" & rFind.Address End If Next rMatch End If Next wks End With End Sub

Beliebteste Forumthreads (12 Monate)

Erstellen Werkzeugliste aus Tabellenblätter

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Erstellen Werkzeugliste aus Tabellenblätter

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread