Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1628to1632
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
Inhaltsverzeichnis

VBA: identische Blätter(-namen) einsammeln

VBA: identische Blätter(-namen) einsammeln
22.06.2018 15:52:05
silex1
Hallo,
ich habe eine Datei (CB_2018.xls) mit nur einem Blatt (Blattname z.B. "997191234").
Nun gibt es in einem Ordner "C:/A_Rene/CB2018" mehrere Arbeitsmappen, welche im Format "XX_06_2018.xls" bezeichnet sind (XX steht hier für eine Zahl oder Text).
Ich würde gern ein Makro haben, was nun anhand des Blattnamens, alle Dateien aus dem o.g. Ordner durchforstet und wenn es in einer Mappe den selben Blattnamen findet (ist nicht in allen Mappen auch tatsächlich vorhanden), soll es das gesamte Blatt in die Datei als neues Blatt kopieren UND das XX als Blattname nehmen.
als Bsp.
Die Mappe heißt "Rene_CB2018" und hat nur ein Blatt mit Blattname "997191234".
Das Makro öffnet nun die erste Mappe (z.B. "13_06_2018.xls"), findet den Blattnamen nicht und geht zur nächsten Mappe (z.B. "Cola_06_2018.xls"). Dort findet es das Blatt mit dem Namen "997191234", kopiert es in meine Mappe und benennt es um in das, was vor dem ersten _ steht. Also hier z.B. in "Cola". Und dies muss das Makro halt mit allen xls machen, die in dem o.g. Ordner sind.
Falls es beim sammeln hilft, die zu suchenden Blattnamen bestehen immer aus 9 Zahlen und die Umbenennung ist eine 1 bis 2 stellig Zahl oder Text.
Vielleicht hat ja jemand Lust und mag mir dabei helfen.
Mit dankbaren Grüßen
René

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ... einsammeln
22.06.2018 16:37:14
mmat
Das müsste es sein. Ich hoffe es ist fehlerfrei (kann's ja nicht testen,)
Sub einsammeln()
Dim p As Long, s As String, wb As Workbook, twb As Workbook, ws As Worksheet
Const Pfad = "c:\A_Rene\"
Const Blatt = "997191234"
Set twb = ThisWorkbook
s = Dir(Pfad + "*.xls", vbNormal)
While s  ""
Set wb = Workbooks.Open(Pfad + s)
On Error Resume Next
Set ws = Worksheets(Blatt)
On Error GoTo 0
If Not (ws Is Nothing) Then
ws.Copy twb.Sheets(1)
p = InStr(s, "_")
ActiveSheet.Name = Left(s, p - 1)
End If
wb.Close False
s = Dir()
Wend
End Sub 

AW: ... einsammeln
22.06.2018 17:45:14
silex1
Hallo,
vielen Dank für die Hilfe.
Also er sucht schon mal alle Blätter zusammen und vergibt auch den richtigen Namen.
Jedoch enthält jedes dieser Blätter dann nicht die Daten aus den einzelnen Datein, sondern es wird das bestehende Blatt (997191234) darüber kopiert. Und so hab ich überall den gleichen Inhalt...
Hab ich was falsch gemacht?
VG René
Anzeige
AW: ... einsammeln
23.06.2018 09:15:04
Matthias
Moin!
ALso habe mal 2 Dateien gebastelt und den Code durchlaufen lassen. Bei mir übernimmt er die Blätter und auch deren Inhalt. Hast du den Code ggf. angepasst/verändert?
VG
AW: ... einsammeln
23.06.2018 20:28:15
silex1
@Matthias,
hatte gestern nur weiße Blätter. Heute an einem anderen Rechner, gleiches Ergebnis.
Vorhin nochmals getestet und es lief plötzlich. Gab zwar ne Fehlermeldung, wenn der Blattname nicht in der Datei war, aber da es nur drei Blätter waren die ich einfügen musste, war es überschaubar.
Ich weiß nicht warum es nun funktionierte...
Danke Dir fürs nachbauen und bestätigen, dass es funktioniert. Ist manchmal auch ne großr Hilfe!
@mmat
Vielen herzlichsten Dank für das Makro. Warum es nicht wollte und nun plötzlich doch will...keine Ahnung.
Aber Danke für die Hilfe, erleichtert mir in Zukunft einiges an Handarbeit.
VG und schönes WE
René
Anzeige
Danke für die Rückmeldung! oT
25.06.2018 10:06:48
mmat
AW: ... einsammeln
23.06.2018 09:41:05
Orhan
Hallo René,
Danke erstmal für die Mühe. Kannst du mir verraten wo ich das einfügen muss damit es funktioniert?
Eigentlich wollte ich, dass der nach zb: "TP 01" sucht und dann die Daten darunter auflistet.
Falscher Thread! owT
23.06.2018 14:15:30
Luc:-?
:-?

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige