Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Makro Mappen in einer Mappe zusammenfassen

Betrifft: Makro Mappen in einer Mappe zusammenfassen von: Discoverer81
Geschrieben am: 03.07.2013 15:18:14

Hallo ihr Makrokundigen.
Ich suche ein Makro, welches mir das Leben leichter macht.

Und zwar sollen alle Excel-Sheets, welche sich in einem Ordner befinden, in einer bestimmten Mappe zusammengefasst werden.
Ziel ist es, jeden Monat das Makro auszuführen, so dass alle Blätter neu zusammengefasst werden.

Diese Mappe mit dem Makro ist aber in einem anderen Verzeichnis als die Blätter, welche zusammengefasst werden sollen.
Auch ändert sich jedes Mal der Name des Verzeichnisses, in dem diese Blätter liegen.
Der Pfad müsste daher eingebbar sein.

Die einzelnen Blätter heißen alle anders, sind aber gleich aufgebaut.

Folgende Prozeduren müßten ablaufen:
Start:
Der Wert aus dem einzelnen Blatt (EB) aus Zelle D8 kommt in das MakroBlatt (MB) in Zelle A7.
EB D7 nach MB B7
EB F23 bis Q23 nach MB D7 bis O7
EB F 32 bis Q32 nach MB U7 bis AF7

Dann das nächste Blatt auslesen und drei Zeilen weiter unten eintragen, usw. usf.

Noch ein kleiner Hinweis am Rande, innerhalb dieser drei Zeilen, steht was, sie sind nicht leer.

Anbei der Link zur Datei.
https://www.herber.de/bbs/user/86189.xls

Danke vorab.
Mein Makro überschreibt immer alles :-(

  

Betrifft: AW: Makro Mappen in einer Mappe zusammenfassen von: Klaus M.vdT.
Geschrieben am: 04.07.2013 09:10:41

Hi,

das bekomme ich hin!

Und zwar sollen alle Excel-Sheets, welche sich in einem Ordner befinden, in einer bestimmten Mappe zusammengefasst werden.
Gib es Unterordner? Müssen die Beachtet werden? Sind in dem / den Ordner/n nur *.xls* Dateien, oder auch PDFs, JPGs und sonstige, die ignoriert werden müssen?

Der Pfad müsste daher eingebbar sein.
Willst du den Pfad explizit selbst eingeben, oder lieber über den sehr komfortablen Windows-Dialog zur Pfadauswahl anclicken?

Die einzelnen Blätter heißen alle anders, sind aber gleich aufgebaut.
Mit "Blätter" meinst du "Dateien", richtig?
Haben die DATEIEN jeweils nur ein BLATT, oder mehrere? Wenn mehrere, muss jedes oder nur eins gecheckt werden? Wenn mehrere, alle oder eine Auswahl? Wenn nur eins, welches? Blatt Index 1? Oder immer gleicher Blattname?

Start:
Der Wert aus dem einzelnen Blatt (EB) aus Zelle D8 kommt in das MakroBlatt (MB) in Zelle A7.
EB D7 nach MB B7
EB F23 bis Q23 nach MB D7 bis O7
EB F32 bis Q32 nach MB U7 bis AF7

Das Makroblatt ist in deiner Musterdatei das Blatt "Daten"? Lad bitte mal ein oder zwei Beispiele für die EB hoch, zum testen.
Das zeilen-Hochzählen (7, 10, 13 ..) ist kein Problem.

Noch ein kleiner Hinweis am Rande, innerhalb dieser drei Zeilen, steht was, sie sind nicht leer.
Also: in 7 einfügen, Formeln in 8 und 9 erhalten. in 10 einfügen, formeln in 11 und 12 erhalten.
Ausserdem die Formeln in den Spalten P:S (und allen anderen) erhalten. Richtig?

Grüße,
Klaus M.vdT.


  

Betrifft: AW: Makro Mappen in einer Mappe zusammenfassen von: Discoverer81
Geschrieben am: 04.07.2013 09:52:16

Hallo Klaus!
Danke für deine Antwort und für deien vilen Fragen.

Also, es gibt keine Unterordner und nur diese einzelnen Excel-Dateien.

Ein Windows-Dialog wäre schon dekadent, sehr gerne!

Ja, ich meinte Dateien.
Ich habe eine davon angehangen. https://www.herber.de/bbs/user/86196.xlsx
Es sind anscheinend doch mehrere Blätter in jder Datei (waren versteckt), doch ich brauche nur die
"Day 4 Actuals". Dieser Name ist auch überall gleich.

Die Anordnung der Zellen hast du korrekt verstanden.

Danke dir!

Grüße,
Disco


  

Betrifft: AW: Makro Mappen in einer Mappe zusammenfassen von: Klaus M.vdT.
Geschrieben am: 04.07.2013 10:05:57

Hallo "Disco",

hab ich bei meiner ersten Antwort vergessen: Wir bevorzugen hier Realnamen / Vornamen! Wenn du wirklich "Discoverer" heisst, entschuldige ich mich.

Um Serverplatz zu sparen, lade ich die Tabelle nicht extra hoch. Hier der Code, auf den du per Button linken darfst:

Option Explicit

Sub HoleVieleExterneDaten()
'holt externe Daten aus allen *.xls* - Dateien eines Ordners

On Error GoTo hell
'mögliche Fehler: keine Dateien im Ordner, Datei-Tab "Day 4 Actuals" existiert nicht, usw usw .. _
.

Const StartFolder As String = "C:\" 'Um die Pfad-Auswahl immer in C:\ anzufangen ... kannst du  _
gerne anpassen!
Const ZielTab As String = "Daten"   'Hier Hin
Const InfoTab As String = "Info"     'so heisst dein Info-Tab
Const ZeileStep As Integer = 3      'immer um 3 Zeilen hochzählen
Const SpalteListe As Long = 4       'im Blatt "Info" ist die Spalte 4 (=D) frei
Const QuelleTabelle As String = "Day 4 Actuals"
Dim ZielZeile As Long
ZielZeile = 7                       'in Zeile 7 anfangen
Dim i As Long
Dim r As Range

Dim sPath As String
Dim sFile As String
Dim wkbOld As Workbook
Dim wkbNew As Workbook

Application.ScreenUpdating = False

'Workbook merken
Set wkbOld = ActiveWorkbook

'temporäre Dateinamen-Liste löschen
Sheets(InfoTab).Columns(SpalteListe).ClearContents

'*************** Alle Dateinamen auflisten
i = 1
sPath = ChooseAFolder(StartFolder)  'Holt einen Pfad per Windows-Dialog
'sPath = Sheets(InfoTab).Range("C9").Value       'Alternative: Pfad aus Zelle holen
sFile = Dir(sPath & "*.xls")
Do While sFile <> ""
    Sheets(InfoTab).Cells(i, SpalteListe).Value = sFile
    i = i + 1
    sFile = Dir()
Loop
'Alle Dateinamen auflisten ***************


'********** Alle Dateien durchlaufen, öffnen, kopieren, schließen
For Each r In Sheets(InfoTab).Cells(1, SpalteListe).Resize(Cells(Sheets(InfoTab).Rows.Count,  _
SpalteListe).End(xlUp).Row, 1)
    r.Select
    Workbooks.Open sPath & r.Value, UpdateLinks:=False
    Set wkbNew = ActiveWorkbook
    'ich gehe davon aus, es gibt immer nur EINE Tabelle!
    With Sheets(QuelleTabelle)
        wkbOld.Sheets(ZielTab).Range("B" & ZielZeile).Value = .Range("D7").Value
        wkbOld.Sheets(ZielTab).Range("D" & ZielZeile & ":O" & ZielZeile).Value = .Range("F23: _
Q23").Value
        wkbOld.Sheets(ZielTab).Range("U" & ZielZeile & ":AF" & ZielZeile).Value = .Range("F32: _
Q32").Value
    End With
    ZielZeile = ZielZeile + ZeileStep

    wkbNew.Close False
Next r
'Alle Dateien durchlaufen, öffnen, kopieren, schließen **********

'temporäre Dateinamen-Liste löschen
Sheets(InfoTab).Columns(SpalteListe).ClearContents

GoTo heaven:
hell:
MsgBox "Fehler in HoleVieleExterneDaten" & vbCrLf _
 & "Fehlernummer: " & Err.Number & _
 vbCrLf & "Fehlerbeschreibung: " & Err.Description

heaven:
Application.ScreenUpdating = True

End Sub

Public Function ChooseAFolder(sPathStart)
    Dim sFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = sPathStart
        .Title = "Pick a Folder"
        .ButtonName = "choose..."
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            sFolder = .SelectedItems(1)
            If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
          Else
            sFolder = ""
        End If
    End With
    If sFolder = "" Then
        ChooseAFolder = ""
        'MsgBox ("no Folder!")
    Else
        ChooseAFolder = sFolder
    End If
End Function
Die meisten änderbaren Sachen habe ich als CONST nach ganz oben geholt, so dass eine Codeanpassung bei abeweichenden Ordnernamen / Startzeilen usw sehr einfach sein sollte.
Ich habe mit NICHT die Mühe gemacht, deine etwas komplexeren Kopierbereiche mit CONST zu dynamisieren - behalt einfach die Dateistruktur bei :-)

Grüße,
Klaus M.vdT.


  

Betrifft: AW: Makro Mappen in einer Mappe zusammenfassen von: Discoverer81
Geschrieben am: 04.07.2013 10:44:59

Hallo Klaus,

ich glaube mein Makroverständnis hörte bereits hinter den ersten zwei Zeilen auf ;-).

Allerdings gibt er noch einen Syntaxfehler vor.

Option Explicit

Sub HoleVieleExterneDaten()
'holt externe Daten aus allen *.xls* - Dateien eines Ordners

On Error GoTo hell
'mögliche Fehler: keine Dateien im Ordner, Datei-Tab "Day 4 Actuals" existiert nicht, usw usw .. _
.

Const StartFolder As String = "Z:\" 'Um die Pfad-Auswahl immer in C:\ anzufangen ... kannst du _
gerne anpassen!
Const ZielTab As String = "Daten" 'Hier Hin
Const InfoTab As String = "Info" 'so heisst dein Info-Tab
Const ZeileStep As Integer = 3 'immer um 3 Zeilen hochzählen
Const SpalteListe As Long = 4 'im Blatt "Info" ist die Spalte 4 (=D) frei
Const QuelleTabelle As String = "Day 4 Actuals"
Dim ZielZeile As Long
ZielZeile = 7 'in Zeile 7 anfangen
Dim i As Long
Dim r As Range

Dim sPath As String
Dim sFile As String
Dim wkbOld As Workbook
Dim wkbNew As Workbook

Application.ScreenUpdating = False

'Workbook merken
Set wkbOld = ActiveWorkbook

'temporäre Dateinamen-Liste löschen
Sheets(InfoTab).Columns(SpalteListe).ClearContents

'*************** Alle Dateinamen auflisten
i = 1
sPath = ChooseAFolder(StartFolder) 'Holt einen Pfad per Windows-Dialog
'sPath = Sheets(InfoTab).Range("C9").Value 'Alternative: Pfad aus Zelle holen
sFile = Dir(sPath & "*.xls")
Do While sFile <> ""
Sheets(InfoTab).Cells(i, SpalteListe).Value = sFile
i = i + 1
sFile = Dir()
Loop
'Alle Dateinamen auflisten ***************


'********** Alle Dateien durchlaufen, öffnen, kopieren, schließen
For Each r In Sheets(InfoTab).Cells(1, SpalteListe).Resize(Cells(Sheets(InfoTab).Rows.Count, _
SpalteListe).End(xlUp).Row, 1)
r.Select
Workbooks.Open sPath & r.Value, UpdateLinks:=False
Set wkbNew = ActiveWorkbook
'ich gehe davon aus, es gibt immer nur EINE Tabelle!
With Sheets(QuelleTabelle)
wkbOld.Sheets(ZielTab).Range("B" & ZielZeile).Value = .Range("D7").Value
wkbOld.Sheets(ZielTab).Range("D" & ZielZeile & ":O" & ZielZeile).Value = .Range("F23: _
Q23").Value
wkbOld.Sheets(ZielTab).Range("U" & ZielZeile & ":AF" & ZielZeile).Value = .Range("F32: _
Q32").Value

End With
ZielZeile = ZielZeile + ZeileStep

wkbNew.Close False
Next r
'Alle Dateien durchlaufen, öffnen, kopieren, schließen **********

'temporäre Dateinamen-Liste löschen
Sheets(InfoTab).Columns(SpalteListe).ClearContents

GoTo heaven:
hell:
MsgBox "Fehler in HoleVieleExterneDaten" & vbCrLf _
& "Fehlernummer: " & Err.Number & _
vbCrLf & "Fehlerbeschreibung: " & Err.Description

heaven:
Application.ScreenUpdating = True

End Sub

Public Function ChooseAFolder(sPathStart)
    Dim sFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = sPathStart
        .Title = "Pick a Folder"
        .ButtonName = "choose..."
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            sFolder = .SelectedItems(1)
            If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
          Else
            sFolder = ""
        End If
    End With
    If sFolder = "" Then
        ChooseAFolder = ""
        'MsgBox ("no Folder!")
    Else
        ChooseAFolder = sFolder
    End If
End Function
Grüße,
Michael


  

Betrifft: AW: Makro Mappen in einer Mappe zusammenfassen von: Klaus M.vdT.
Geschrieben am: 04.07.2013 10:53:22

Hallo Michael,

Bei mir läuft es durch! Syntaxfehler heisst, das Makro startet gar nicht erst und markiert die Zeilen gelb und die folgende rot?
Ich vermute, da hat die Forumssoftware die Zeilenumbrüche _ falsch interpretiert. Nimm die mal per Hand raus (am besten alle):

wkbOld.Sheets(ZielTab).Range("D" & ZielZeile & ":O" & ZielZeile).Value = .Range("F23:Q23").Value
wkbOld.Sheets(ZielTab).Range("U" & ZielZeile & ":AF" & ZielZeile).Value = .Range("F32:Q32").Value


Oder warte, ich lad dir einfach doch die Datei hoch das ist vielleicht einfacher.
https://www.herber.de/bbs/user/86201.xls

Dass du oben die CONST eventuell noch anpassen musst, falls deine Blätter nicht exakt "Daten" , "Info" , "Day 4 Actuals" heissen oder deine Startzeilen anders sind, hast du verstanden und umgesetzt?

Zum Makroverständniss:
die schwierigen Teile, Dateien-auflisten und Windows-Dialog, stammen auch nicht von mir! Aber mit der Zeit legt man sich eine ganz ansehnliche Sammlung aus funktionalem Code aus den Foren und Excelseiten an, den man dann bei Bedarf nur noch rüberkopiert.

Grüße,
Klaus M.vdT.


  

Betrifft: AW: Makro Mappen in einer Mappe zusammenfassen von: Discoverer81
Geschrieben am: 04.07.2013 12:10:25

Hallo Klaus,

jetzt läuft alles reibungslos.
Allerdings habe ich leider feststellen müssen, dass meine Idee nichts taugt.
Und mein Versuch, trotz deiner ausführlichen Kommentare, es selbst hinzubekommen, hat leider nicht funktioniert.

Ich möchte nun die Daten der Blätter in eine neues Blatt (Datenblatt) sammeln und sie dann per Formeln zurechtweisen.

Dazu brauche ich folgendes:
Alle Daten kommen in das Blatt "Datenblatt".

Die Info aus den einzelnen Blätter aus D7 kommt in Datenblatt A1.
F23 bis Q23 (Einzelblatt) kommt nach B2 bis M2 (Datenblatt).
F32 bis Q32 (Einzelblatt) nach O2 bis Z2 (Datenblatt).

Alles kann direkt untereinander.

Hast du dafür noch Zeit????

Liege Grüße
Micha


  

Betrifft: AW: Makro Mappen in einer Mappe zusammenfassen von: Klaus M.vdT.
Geschrieben am: 04.07.2013 12:22:15

Hi Michael,

das sollte GANZ einfach gehen!

[...]
Const ZielTab As String = "Datenblatt" 'Hier Hin
Const InfoTab As String = "Info" 'so heisst dein Info-Tab
Const ZeileStep As Integer = 1 'immer um 3 Zeilen hochzählen
Const SpalteListe As Long = 4 'im Blatt "Info" ist die Spalte 4 (=D) frei
Const QuelleTabelle As String = "Day 4 Actuals"
Dim ZielZeile As Long
ZielZeile = 2 'in Zeile 7 anfangen
[...]
wkbOld.Sheets(ZielTab).Range("B" & ZielZeile & ":M" & ZielZeile).Value = .Range("F23:Q23").Value
wkbOld.Sheets(ZielTab).Range("O" & ZielZeile & ":Z" & ZielZeile).Value = .Range("F32:Q32").Value
[...]

Grüße,
Klaus M.vdT.


  

Betrifft: einen Übersehen von: Klaus M.vdT.
Geschrieben am: 04.07.2013 12:24:05

Hi,

den hier
Die Info aus den einzelnen Blätter aus D7 kommt in Datenblatt A1.
verstehe ich nicht. "A2 und dann untereinander" würd ja mehr Sinn machen, oder?

Grüße,
Klaus M.vdT.


  

Betrifft: AW: einen Übersehen von: Discoverer81
Geschrieben am: 04.07.2013 12:47:47

Hallo Klaus.
Super, fast perfekt.
Ich hatte da ein paar Änderugnen mehr vorgenommen. Kein Wunder dass es danach aussah wie "Godzilla in Tokio".

Jezt ist nur noch die Sache mit der Info aus D7.
Diese sollen auch untereinander aufgelistet werden, da sie der Schlüsselcode sind.
Sprich zu jedem Schlüsselcode gibt es den Umsatz.

In den einzelnen Blättern sind diese in der Zelle D7 hinterlegt.
Und ja, sie sollen auch ausgelesen und untereinander gelistet werden.

Grüße
Micha


  

Betrifft: AW: einen Übersehen von: Klaus M.vdT.
Geschrieben am: 04.07.2013 13:14:36

Hi Micha,

das mit D7 anzupassen ist doch jetzt einfach, oder? Versuch doch mal, das selbst hinzubekommen - das Erfolgserlebnis kann dir niemand nehmen!

Als Notanker kannst du auch den Code aus dieser Datei nehmen:
https://www.herber.de/bbs/user/86205.xls
Da habe ich allerdings nochmal drin rumoptimiert und die "Kopieren - Einfügen" Bereiche nun DOCH Variabel in CONST-Zeilen am Anfang des Codes gestaltet. Dazu musste ich ein paar Zeilen mehr ändern (.values auf .values Zuweisen habe ich rausgeworfen und durch "copy-paste" ersetzt) um auch eine variable Spaltenanzahl mitnehmen zu können.

Grüße,
Klaus M.vdT.


  

Betrifft: AW: einen Übersehen von: Discoverer81
Geschrieben am: 04.07.2013 14:32:09

Hallo Klaus.

Vielen Dank.
Ich musste aber auf den Code zurückgreifen, nachdem ich den Wald vor lauter Bäumen nicht fand.
Werde ihn aber zu verstehen versuchen.

Danke und einen schönen Nachmittag.

Grüße
Michael


  

Betrifft: Danke für die Rückmeldung! owT. von: Klaus M.vdT.
Geschrieben am: 04.07.2013 15:08:32

.


 

Beiträge aus den Excel-Beispielen zum Thema "Makro Mappen in einer Mappe zusammenfassen"