Aus XIMES
Option Explicit
'
Sub Blätter_Einspielen_mit_Range_von_DateiNamen()
' Modul zum Zusammenfassen mehrerer Blätter aus verschiedenen Dateien
' ALLE BLÄTTERN EINSPIELEN zB Abteilung A 01.02.2006.xls, Abteilung A 02.02.2006.xls, Abteilung A 03.02.2006.xls
' Wie heißen die Dateien?
Dim DateiNameAnfang As String
Dim DateiNameEnde As String
Dim DateiNamen As Range
Dim LaufenderDateiName As String
Dim PathUndFilename As String
'
Dim Blattname As String
'
Dim DateiNameDerHauptdatei As String
'
Dim i, j As Integer
'
DateiNameDerHauptdatei = ActiveWorkbook.Name
'
' Einlesen
' Wie kann man die Anzahl der Dateien flexibel halten und die Range flexibel definieren?
'
Set DateiNamen = Range("DateiNamen") '<<< ANPASSEN oder zB ActiveWorkbook.Names.Add Name:="DateiNamen", RefersToR1C1:="=Ergebnisse!R2C1:R32C1"
' In diesem Range stehen die sich ändernden werte zB 01 02 03
'
DateiNameAnfang = _
InputBox("Geben Sie die exakte Zeichenfolge des Dateinamens vor dem Datumsteil ein", , "Abteilung A ")
DateiNameEnde = _
InputBox("Geben Sie die exakte Zeichenfolge des Dateinamens nach dem Datumsteil ein", , ".02.2006.xls")
'
For i = 1 To DateiNamen.Rows.Count
If DateiNamen(i, 1) <> "" Then
LaufenderDateiName = DateiNameAnfang & DateiNamen(i, 1) & DateiNameEnde
PathUndFilename = ThisWorkbook.Path + "\" + LaufenderDateiName
Workbooks.Open Filename:=PathUndFilename
'
Blattname = ActiveWorkbook.Sheets(1).Name
Sheets(Blattname).Copy After:=Workbooks(DateiNameDerHauptdatei).Sheets(Workbooks(DateiNameDerHauptdatei).Sheets.Count)
Sheets(Blattname).Select
Sheets(Blattname).Name = DateiNamen(i, 1)
'
Workbooks(LaufenderDateiName).Close
End If
Next
'
End Sub
