AW: Kopie von ungeöffneten Dateien mit variablen Namen
07.08.2014 17:49:20
ungeöffneten
Hallo Andi,
natürlich braucht man für ein VBA-Programm noch mehr Informationen, aber vielleicht kommst du mit dem folgenden Beispiel weiter.
Das Programm geht davon aus, dass deine Mappe "Kontrollübersicht.xls" mindestens die beiden Blätter "Dateien" und "Ergebnis" hat.
Im Blatt "Dateien" stehen in den Spalten A, B und C ab Zeile 2 jeweils Name, Monat und Jahr.
Das Blatt "Ergebnis" wird bei jeder Programmausführung ab Zeile 2 neu aufgebaut.
Außerdem befindet sich das VBA-Programm in dieser Arbeitsmappe.
Die Arbeitsmappen "Name_Monat_Jahr.xls" enthalten ein Blatt namens "Tabelle1". Aus diesem Blatt werden aus den Zellen B3 und H27 Daten entnommen.
Sub Übersicht_erstellen()
Dim datei As String
Dim jahr As Long
Dim letzteZeileD As Long
Dim monat As Long
Dim name As String
Dim pfad As String
Dim wbQ As Workbook ' Quelle
Dim wbZ As Workbook ' Ziel
Dim wsQ As Worksheet
Dim wsD As Worksheet ' Blatt "Dateien"
Dim wsE As Worksheet ' Blatt "Ergebnis"
Dim zeileD As Long ' Zeilenzählung im Blatt "Dateien"
Dim zeileE As Long ' Zeilenzählung im Blatt "Ergebnis"
Set wbZ = ThisWorkbook
Set wsD = wbZ.Worksheets("Dateien")
' Spalte mit Fehlermeldungen löschen
wsD.Columns("G").ClearContents
Set wsE = wbZ.Worksheets("Ergebnis")
' Bisherigen Inhalt des Blattes "Ergebnis" löschen
wsE.Range(wsE.Rows(2), _
wsE.Rows(wsE.Rows.Count)).ClearContents
letzteZeileD = wsD.Cells(wsD.Rows.Count, "A").End(xlUp).Row
zeileE = 2
For zeileD = 2 To letzteZeileD
name = wsD.Cells(zeileD, "A")
monat = wsD.Cells(zeileD, "B")
jahr = wsD.Cells(zeileD, "C")
pfad = "C:\Deutschland\" & name & "\Inventuren\"
datei = name & "_" & Format$(monat, "00") & "_" & jahr & ".xls"
If Dir(pfad & datei) "" Then
' Arbeitsmappe ist vorhanden
' datei vorsorglich schließen
Application.DisplayAlerts = False
On Error Resume Next
Workbooks(datei).Close
On Error GoTo 0
Application.DisplayAlerts = True
Set wbQ = Workbooks.Open(Filename:=pfad & datei)
Set wsQ = wbQ.Worksheets("Tabelle1")
' Werte in das Blatt Ergebnis übernehmen (hier Phantasie)
wsE.Cells(zeileE, "A") = wsQ.Range("B3")
wsE.Cells(zeileE, "B") = wsQ.Range("H27")
zeileE = zeileE + 1
wbQ.Close SaveChanges:=False
Else
' Arbeitsmappe ist nicht vorhanden
wsD.Cells(zeileD, "G") = pfad & datei & " ist nicht vorhanden"
End If
Next zeileD
wsE.Activate
End Sub
Ich lade meine Datei "Kontrollübersicht.xls" hoch:
https://www.herber.de/bbs/user/91958.xls
Viele Grüße
Dieter