VBA _ Makro _ Excel Zusammenfügen Daten

Hallo Liebe Excel_VBA Freunde,
leider kann ich keine Daten hochladen was eure Hilfe / Aufgabe erschweren wird.
Mein Problem sieht wie folgt aus:
ich habe zwei Excel Dateien, die eine ist die ZielDatei und die andere die Quelle.
Quelle:
Ich habe eine Excel mit mehr als 250 tabs. diese tragen den Namen A01,A02,A03... W01,W02...usw.
Von jedem tab muss ich bestimmte Zellen auslesen bzw. kopieren (circa 10 Zellen). die Zellen beinhalten Zahlen oder Buchstaben. Die Zellen haben bei jedem tab die selbe Position.
Ziel:
In der Ziel Excel liste habe ich schon eine Tabelle aufgebaut wo ich nun die Informationen zusammen tragen möchte.
Beispiel:
In der Quelle steht in Zelle B3 ein Name; in der Zelle F13 steht eine Zahl.
nun will ich den Namen von B3 in die Ziel Datei in die Zelle B1 und die Zahl von F13 in die Zelle C1 einfügen.
Nun soll das selbe für die anderen 250 tabs gemacht werden, wobei sich die Position der Quelle (Zelle B1 und F13) nicht verändert. jedoch soll es in der Ziel Liste fortlaufend eingefügt werden (B2,B3 - BXX ; C2,C3....).
ob die (Quelle) Excel offen oder geschlossen ist wäre egal.
ich hab schonmal probiert ein bisschen rumzubauen und von vergleichbaren Problemfälle VBA makros einzubauen, aber ich komme leider alleine nicht mehr weiter.
Darum wäre es sehr lieb, wenn ihr mir helfen könntet.
Vielen Dank im Voraus.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub Sammeln() Dim loLetzte As Long, ws As Worksheet Application.ScreenUpdating = False 'Blattname anpassen With Worksheets("Sammelmappe") For Each ws In ThisWorkbook.Worksheets If ws.Name "Sammelmappe" Then loLetzte = .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Row If .Cells(1, "B") = "" Then loLetzte = 1 .Cells(loLetzte, "B") = ws.Range("B3") .Cells(loLetzte, "C") = ws.Range("F13") End If Next ws End With End Sub

Sub Unit() Dim Q As Workbook, L As Long, V As Variant, Z As Range Set Q = Workbooks("Name_der_Quelldatei.xlsx") Set Z = ThisWorkbook.Worksheets("Tabelle1").Range("B1") If Z "" Then Set Z = Z.Parent.Cells(Z.Parent.Rows.Count, 2).End(xlUp).Offset(1) ReDim V(1 To Q.Worksheets.Count, 1 To 2) For L = 1 To Q.Worksheets.Count V(L, 1) = Q.Worksheets(L).Cells(3, 2).Value V(L, 2) = Q.Worksheets(L).Cells(13, 6).Value Next L Z.Resize(UBound(V, 1), 2) = V Erase V Set Z = Nothing: Set Q = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

VBA _ Makro _ Excel Zusammenfügen Daten

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread