Makro um Blätter von versch. Dateien einzubinden

versch. · 2014-08-28T12:52:02+00:00

Hey, ich bräuchte ein Makro, was folgendes kann (Habe da leider nicht mal einen Ansatz für...): Ich habe sehr viele (ca. 80) gleich aufgebaute Excel-Dateien. Das Makro soll mir jetzt von diesen ganzen Dateien, die Daten im Tabellenblatt "Übersicht" ab einer entsprechenden Zeile (die ist immer gleich) bis zur letzten beschriebenen Zeile untereinander kopieren (nur Werte!). Ist das überhaupt möglich? Oder muss ich mir etwas anderes einfallen lassen?

Hallo Andi,
hier das Gerüst für ein entsprechendes Makro.
Gruß
Franz

Sub DatenZusammensuchen()
Dim wkbQuelle As Workbook, wksQuelle As Worksheet, varQuelle As Variant
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim Zeile_Z As Long, Zeile_Q As Long, Zeile_Q1 As Long
Dim Zelle As Range, rngCopy As Range
On Error GoTo Fehler
Set wkbZiel = ActiveWorkbook
Set wksZiel = wkbZiel.Worksheets("Tabelle1")
With wksZiel
'1. Einfügezeile in Ziel-abelle ermitteln
Set Zelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If Zelle Is Nothing Then
Zeile_Z = 1
Else
Zeile_Z = Zelle.Row + 1
End If
End With
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte die Datei mit den Quelldaten auswählen (Mehrfach-Auswahl ist möglich)"
.AllowMultiSelect = True
Application.ScreenUpdating = False
If .Show = -1 Then
For Each varQuelle In .SelectedItems
Set wkbQuelle = Application.Workbooks.Open(varQuelle, ReadOnly:=True)
Set wksQuelle = wkbQuelle.Worksheets("Übersicht")       ' - ggf. anpassen
Zeile_Q1 = 3 '1. zu kopierende Zeile in Quellblättern   - ggf. anpassen
With wksQuelle
Set Zelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If Zelle Is Nothing Then
'keine Daten im Tabellenblatt - leeres Blatt
ElseIf Zelle.Row


Sub Betriebsbögen_importieren()
Dim wkbQuelle As Workbook, wksQuelle As Worksheet, varQuelle As Variant
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim Zeile_Z As Long, Zeile_Q As Long, Zeile_Q1 As Long
Dim Zelle As Range, rngCopy As Range
On Error GoTo Fehler
Set wkbZiel = ActiveWorkbook
Set wksZiel = wkbZiel.Worksheets("Gesamtübersicht")
With wksZiel
'1. Einfügezeile in Ziel-abelle ermitteln
Set Zelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If Zelle Is Nothing Then
Zeile_Z = 1
Else
Zeile_Z = Zelle.Row + 1
End If
End With
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte die Datei mit den Quelldaten auswählen (Mehrfach-Auswahl ist möglich)"
.AllowMultiSelect = True
Application.ScreenUpdating = False
If .Show = -1 Then
For Each varQuelle In .SelectedItems
Set wkbQuelle = Application.Workbooks.Open(varQuelle, ReadOnly:=True)
Set wksQuelle = wkbQuelle.Worksheets("Übersicht")
With wksQuelle
Zeile_Q1 = 7
'Letzte Zeile verschieden von "" in Spalte F
Zeile_Q = fncLetzteVerschieden_von_Leer(wks:=wksQuelle, Spalte:=6)
If Zeile_Q = 0 Then
MsgBox "'keine Daten im Tabellenblatt - leeres Blatt"
ElseIf Zeile_Q  "" Then
fncLetzteVerschieden_von_Leer = lngZeile
Exit For
End If
Next
End With
End Function

So funktioniert es irgendwie nicht...

Makro um Blätter von versch. Dateien einzubinden

Forumthread: Makro um Blätter von versch. Dateien einzubinden

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Makro um Blätter von versch. Dateien einzubinden

Forumthread: Makro um Blätter von versch. Dateien einzubinden

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread