Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Daten und Tabellen aus Arbeitsmappen auslesen

Daten und Tabellen aus Arbeitsmappen auslesen
Rene
Hallo Experten,
ich habe ein Makro gefunden und an meine Bedürfnisse so weit wie möglich angepasst. Leider bekomme ich ab Variable 21 die Fehlermeldung 400.
https://www.herber.de/bbs/user/73664.xls (enthält das Makro)
Das Makro sollte die Daten aus allen Excel-Arbeitsmappen im Verzeichnis "C:\Test\Daten\" auslesen und diese in eine neue Arbeitsmappe schreiben. Habe mal schnell eine Datei erstellt, die man im Verzeichnis vervielfachen kann, um das Makro zu testen. https://www.herber.de/bbs/user/73665.xls
In dieser sollen die Daten dann weiter bearbeitet werden.
Schön wäre es, wenn das Verzeichnis mit einer Inbox abgefragt werden könnte, dann würde ich mir das Anpassen des Verzeichnisses jedes Monat ersparen.
Weiters hätte ich noch in jeder Arbeitsmappe ein Arbeitsblatt "Abrechnung", die eine Tabelle enthält, die ich gerne in eine fortlaufende Liste in ein zweites Blatt in die zu erstellen Datei einfügen möchte.
Wie gesagt, habe ich ein Makro gefunden und an meine Bedürfnisse angepasst, leider funktioniert es nicht ganz, wenn ich den Zellenbereich über 21 erweitere, dann bekomme ich die Fehlermeldung 400.
Für die fortlaufende Liste habe ich noch nichts gefunden. Ich dachte, ich suche nach einem Makro, das die TAbelle in das zweite Blatt in die nächste leere Zeile kopiert.
Vielleicht gibt es ja auch eine viel einfachere Möglichkeit?
Die Dateien, aus denen die Werte ausgelesen werden, bestehen aus 15 Arbeitsblättern, wobei die Daten auf Arbeitsblatt 1 zusammengefasst sind.
Es sollen Werte eingefügt werden.
Dh, auf dem ersten Tabellenblatt sollen die Daten aus allen Arbeitsblättern eines Verzeichnisses in Form einer Tabelle dargestellt werden
Auf dem zweiten Tabellenblatt oder gerne auch in einer neuen Mappe möchte ich gerne eine Liste erstellen, deren Daten aus dem Arbeitsblatt "Abrechnung" stammen, das in jeder Arbeitsmappe enthalten ist.
Wünsche noch einen schönen Abend.
Gruß
René

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

Betreff
Benutzer
Anzeige
AW: Daten und Tabellen aus Arbeitsmappen auslesen
22.02.2011 23:12:34
fcs
Hallo René,
hier dein Makro angepasst an deine Wunschliste. das FileSearch-Objekt existiert unter Excel 2007 nicht mehr. Ich hab es durch "Dir" in Kombination mit einer Do-Loop-Schleife ersetzt.
Die aus der Übersicht auszulesenden Zellen sind jetzt in einem Array festgelegt. Das ermöglicht das "einfache" abarbeiten in einer For-Next-Schleife.
Für die Daten aus dem Blatt Abrechnung wird "einfach" ein 2. Blatt in der Daei angelegt und per Copy und PasteSpecial jeweils der Inhalt aus dem Bereich A6:J30 übertragen.
Speichere das Makro im VBA-Projekt bitte in einem allgemeinen Modul - nicht unter "DieseArbeitsmappe". Es kann sonst zu Problemen bei der Makroausführung kommen.
Gruß
Franz
'Erstellt/überarbeitet unter Excel 2007
Sub Import_Kassabuchdaten()
Dim wbKM As Workbook, wb As Workbook, wksQuelle As Worksheet
Dim wksKM As Worksheet, wksAbr As Worksheet
Dim Verzeichnis As Variant, DateiName As String, ZellBereich$, arrZellen
Dim i As Integer, ZeileKM As Long, ZeileAbr As Long, Spalte As Long
'Neue Mappe anlegen
Set wbKM = Workbooks.Add(Template:=xlWBATWorksheet)
Set wksKM = wbKM.Worksheets(1)
Range("B2").Select
ActiveWindow.FreezePanes = True
'Blatt für Abrechnungsdaten einfügen
wbKM.Worksheets.Add After:=wbKM.Sheets(wbKM.Sheets.Count)
Set wksAbr = wbKM.Sheets(2)
Range("A2").Select
ActiveWindow.FreezePanes = True
'Verzeichnis auswählen
With Application.FileDialog(msoFileDialogFolderPicker) 'Hier Verzeichnis anpassen
.Title = "Verzeichnis für Dateien des Monats auswählen"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewDetails
If .Show = 0 Then Exit Sub
Verzeichnis = .SelectedItems(1)
End With
'auszulesende Zellen
arrZellen = Array("C5", "C7", "C11", "C13", "C15", "C17", "C19", "C21", "C24", _
"b98", "C43", "D43", "E43", "H43", "F43", "G43", "P45", "Q45", "R45", "s45", "t45", _
"v45", "C104", "B109", "D107", "E107", "F107", "G107", "B2")
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
DateiName = Dir(Verzeichnis & Application.PathSeparator & "*.xls")
With wksKM
ZeileKM = 1 'Zeile für Spaltentitel in der Tabelle in der Daten eingetragen werden
.Name = "Übersichtsdaten"
Spalte = 1
.Cells(ZeileKM, Spalte) = "Dateiname"
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle1" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle2" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle3" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle4" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle5" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle6" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle7" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle8" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle9" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle10" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle11" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle12" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle13" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle14" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle15" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle16" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle17" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle18" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle19" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle20" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle21" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle22" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle23" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle24" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle25" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle26" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle27" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle28" & "-" & arrZellen(Spalte - 2)
Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle29" & "-" & arrZellen(Spalte - 2)
'        Spalte = Spalte + 1: .Cells(ZeileKM, Spalte) = "Zelle30" & "-" & arrZellen(Spalte - 2)
.Columns(2).NumberFormat = "#,##0" ' Beispiel(deutsch): 2.000
End With
With wksAbr
.Name = "Abrechnung"
Spalte = 1
ZeileAbr = 1
'Spaltentitel für Blatt Abrechnung
.Cells(ZeileAbr, Spalte) = "Spalte 1"
Spalte = Spalte + 1: .Cells(ZeileAbr, Spalte) = "Spalte 2"
Spalte = Spalte + 1: .Cells(ZeileAbr, Spalte) = "Spalte 3"
Spalte = Spalte + 1: .Cells(ZeileAbr, Spalte) = "Spalte 4"
Spalte = Spalte + 1: .Cells(ZeileAbr, Spalte) = "Spalte 5"
Spalte = Spalte + 1: .Cells(ZeileAbr, Spalte) = "Spalte 6"
Spalte = Spalte + 1: .Cells(ZeileAbr, Spalte) = "Spalte 7"
Spalte = Spalte + 1: .Cells(ZeileAbr, Spalte) = "Spalte 8"
Spalte = Spalte + 1: .Cells(ZeileAbr, Spalte) = "Spalte 9"
Spalte = Spalte + 1: .Cells(ZeileAbr, Spalte) = "Zelle10"
ZeileAbr = 2
End With
Do Until DateiName = ""
Application.StatusBar = "Datei " & DateiName & " wird bearbeitet"
Set wb = Workbooks.Open(Filename:=Verzeichnis & Application.PathSeparator _
& DateiName, ReadOnly:=True)
'Übersichtsdaten übertragen
Set wksQuelle = wb.Worksheets(1)
ZeileKM = ZeileKM + 1
Spalte = 1
wksKM.Cells(ZeileKM, 1).Value = wb.Name ' oder wb.FullName, wenn mit Verzeichnis
For i = LBound(arrZellen) To UBound(arrZellen)
Spalte = Spalte + 1
wksKM.Cells(ZeileKM, Spalte).Value = wksQuelle.Range(arrZellen(i))
Next
'Abrechnungsdaten übertragen
Set wksQuelle = wb.Worksheets("Abrechnung")
wksQuelle.Range("A6:J30").Copy
wksAbr.Cells(ZeileAbr, 1).PasteSpecial Paste:=xlPasteFormats
wksAbr.Cells(ZeileAbr, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Nächste Einfüge Zeile
ZeileAbr = ZeileAbr + 25
'Quelldatei wieder schliessen
wb.Close savechanges:=False
'Nächste Quelldatei
DateiName = Dir
Loop
Application.StatusBar = False
'Spaltenbreite optimal einstellen
wksKM.Columns.AutoFit
'Beschleunigungseinstellungen zueücksetzen
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Dialogs(xlDialogSaveAs).Show
End Sub

Anzeige
AW: Daten und Tabellen aus Arbeitsmappen auslesen
23.02.2011 00:52:43
Rene
Hallo Franz,
vielen Dank. Habe das Makro ausprobiert und musste die Zeile ... pastespecial paste:=xlpasteformats löschen, da das Makro entweder mit ...Formats oder ...values funkioniert, jedoch nicht mit beiden. Da ich das Format nicht wirklich benötige möchte ich mich nochmals für deine Hilfe bedanken.
Gruß
Rene

369 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige