Passende Datei in passendes Tabellenblatt

Hallo,
meine 2. Frage, die zu der gleichen Excel-Arbeitsmappe gehört. Folgende Prozesse möchte ich gerne mithilfe von Excel-VBA automatisieren:
1. Mutter-Excel-Datei öffnen und die Namen der Tabellenblätter auslesen (das habe ich bereits im anderen Beitrag erfragt)
2. Ordnerpfad, der wechselt(wird über Eingabefeld ausgewählt, gilt für die gesamte Prozedur, weiß ich, wie ich es mache), öffnen (haben in einem anderem Beitrag gesehen, dass man das irgendwie mit query machen kann - stimmt das auch hier?)
3. Wenn eine Excel-Datei in dem Ordner mit dem selbst 7 Zeichen beginnt wie eines der Excel-Sheets in der Mutterdatei, sollen die Inhalte aus dem ersten Excel-Sheet der Datei in das dazupassende Excel-Sheet komplett kopiert werden.
Ich brauche auch keinen komplett fertig formulierten Code, ich habe in den letzten 2 Jahren hier so viel auch durch s passive Lesen (und gelegentliches Nachfragen) gelernt und würde mich freuen über Tipps freuen, was ich für welchen Teil ca. brauche oder wo ich hier anfangen kann (ich bin ein wenig ratlos, aber überzeugt, dass es geht), damit ich das dann selbst umsetzen kann.
LG
Michi

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Michael,
hier mal das Grundgerüst für so ein Makro.
Gruß
Franz

Sub Test2()
Dim intJ As Integer, varBlattNamen() As String
Dim wkbMutter As Workbook
Dim wkbQ As Workbook, wksQ As Worksheet
Dim varOrdner
Dim strDatei As String
Dim ZeiL As Long, SpaL As Long, StatusCalc As Long
'Mutter-Datei auswählen/öffnen
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte Mutter-Datei öffnen"
If .Show = -1 Then
Set wkbMutter = Application.Workbooks.Open(Filename:=.SelectedItems(1))
Else
Exit Sub
End If
End With
'Ordner mit Dateien auswählen
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Ordner mit Daten-Dateien auswählen"
If .Show = -1 Then
varOrdner = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Makro-Bremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
'Blattnamen in Mutterdatei in Array einlesen
ReDim varBlattNamen(1 To wkbMutter.Worksheets.Count)
For intJ = 1 To wkbMutter.Worksheets.Count
varBlattNamen(intJ) = wkbMutter.Worksheets(intJ).Name
Next
'Dateien im Ordner abarbeiten
strDatei = Dir(varOrdner & "\" & "*.xls*")
Do Until strDatei = ""
For intJ = 1 To UBound(varBlattNamen)
'Anfang Dateiname mit Anfang Blattname vergleichen
If LCase(Left(strDatei, 7)) = LCase(Left(varBlattNamen(intJ), 7)) Then
'Daten-Datei schreibgeschützt öffnen
Set wkbQ = Application.Workbooks.Open(varOrdner & "\" & strDatei, _
ReadOnly:=True)
Set wksQ = wkbQ.Worksheets(1)
'Datenbereich ermitteln und in Mutterdatei kopieren
With wksQ
With .UsedRange
ZeiL = .Row + .Rows.Count - 1
SpaL = .Column + .Columns.Count - 1
End With
.Range(.Cells(1, 1), .Cells(ZeiL, SpaL)).Copy
wkbMutter.Worksheets(varBlattNamen(intJ)).Cells(1, 1).PasteSpecial _
Paste:=xlPasteColumnWidths
wkbMutter.Worksheets(varBlattNamen(intJ)).Cells(1, 1).PasteSpecial _
Paste:=xlPasteAll
Application.CutCopyMode = False
End With
'Daten-Datei wieder schliessen
Set wksQ = Nothing
wkbQ.Close savechanges:=False
Set wkbQ = Nothing
End If
Next intJ
strDatei = Dir
Loop
'Makro-Bremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
MsgBox "Fertig"
End Sub

Beliebteste Forumthreads (12 Monate)

Passende Datei in passendes Tabellenblatt

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread