Tabellenblätter erstellen mit Makro danach einlese
18.01.2012 18:33:38
Thomas
Hallo Franz!
ich bin dem Fehler noch weiter "Nachgelaufen" und hab folgende Vermutung:
Ich hab's fett geschrieben dort wo die Schleifenabbarbeitung beginnt ....
Option Explicit
Sub Auswertung()
Dim rngName As Range
Dim wbAuswert As Workbook, wksZiel As Worksheet, strZiel As String
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim lngZeile As Long, strQuelle As String, rngQuelle As Range
Dim StatusCalc As Long, strMsgTitel As String
Const strCopy As String = "Mustererhebungsblatt" 'Name des Blatts mit zu kopierenden Daten
On Error GoTo Fehler
If MsgBox("Auswertungsdaten einlesen?", vbYesNo) = vbNo Then GoTo Fehler
strMsgTitel = "Fehlermeldung - Auswertung"
Set wbAuswert = ActiveWorkbook 'Datei "Auswertung.xlsm"
'Makrobremsen lösen
With Application
.EnableEvents = False
StatusCalc = .Application.Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'Zellen mit den Dateinamen abarbeiten
For Each rngName In wbAuswert.Worksheets("Basisdaten").Range("C8:C200").Cells
'leere Zellen überspringen
If rngName.Value "" Then
Ich bin mir nicht sicher aber vielleicht ist hier der Hund drin? Es scheint so als ob er _
keinen Dateinamen übernimmt?, sowohl Basisdaten als auch C8:c200 sind richtig, aber er übernimmt nur "" und deswegen steigt er sofort wieder aus... (Next)
'prüfen, ob Datei vorhanden
strQuelle = VBA.Dir(rngName.Value)
strMsgTitel = "Auswertung - Datei " & rngName.Value
If strQuelle = "" Then
'Datei nicht gefunden
Else
'Quelldatei schreibgeschützt öffnen
Set wbQuelle = Workbooks.Open(Filename:=rngName.Value, ReadOnly:=True)
'Prüfen, ob Blatt mit zu kopierenden Daten vorhanden
If fncCheckSheet(varBlatt:=strCopy, wb:=wbQuelle) = True Then
Set wksQuelle = wbQuelle.Worksheets(strCopy)
'Zu kopierender Bereich
With wksQuelle
'letzte Zeile mit Daten in Spalte A
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
'Zeile mit "Summe" suchen
Do
If .Cells(lngZeile, 1) = "Summe" Or lngZeile