komischer Fehler

Ein Hallo ins Forum,
ich habe unten stehenden Code zusammengabaut, der beim Debuggen in Einzelschritten wunschgemäß funktioniert, wenn ich ihn aber durchlaufen lasse bleiben die Zellen leer. Irgendwie scheint es mit dem Eintrag "LetztesBlatt = ActiveWorkbook.Sheets.Count" zusammenzuhängen. Wenn ich dieses deaktiviere und Daten aus irgendwelchen anderen sheets übernehme, klappts.
Ein anderes Phänomen ist auch noch aufgetaucht: Eine Zeit lang hat die Speichern-Abfrage beim Schließen der Arbeitsmappe nicht funktioniert. So lange dies auftrat hatte es auch mit "LetztesBlatt = ActiveWorkbook.Sheets.Count" beim automatischen Durchlauf des Codes funktioniert.
Keine Ahnung warum und wie ich weiter komme.
Vielleicht bzw. hoffentlich hat von Euch jemand eine Idee. Vielen Dank fürs Anschauen.

Sub Zusammenfassen_Resttage()
Dim Datei As String
Dim Arbeitsmappe As String
Dim Pfad As String
Dim i As Integer
Dim LetztesBlatt As Variant
Pfad = "C:\Users\Test\"
Datei = Dir(Pfad & "*.xls")
Application.ScreenUpdating = False
Do While Datei  ""
i = i + 1
ChDir Pfad
Workbooks.Open Filename:=Datei
LetztesBlatt = ActiveWorkbook.Sheets.Count
Sheets(LetztesBlatt).Activate
ActiveSheet.Unprotect
ActiveSheet.Cells(1, 4).Select
Selection.Copy
Windows("Planung_graphisch_neu_2.xls").Activate
Worksheets("Wochenstatistik").Activate
ActiveSheet.Cells(1 + i, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(Datei).Activate
ActiveSheet.Cells(5, 12).Select
Selection.Copy
Windows("Planung_graphisch_neu_2.xls").Activate
Worksheets("Wochenstatistik").Activate
ActiveSheet.Cells(1 + i, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(Datei).Activate
ActiveSheet.Protect
Application.DisplayAlerts = False
ActiveWorkbook.Close False
Datei = Dir()
'Application.Columns.AutoFit
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Zusammenfassen_Resttage() Dim wbZiel As Workbook, wksZiel As Worksheet Dim wbQuelle As Workbook, wksQuelle As Worksheet Dim Datei As String Dim Arbeitsmappe As String Dim Pfad As String Dim i As Long Dim LetztesBlatt As Variant Set wbZiel = Workbooks("Planung_graphisch_neu_2.xls") Set wksZiel = wbZiel.Worksheets("Wochenstatistik") Pfad = "C:\Users\Test\" Datei = Dir(Pfad & "*.xls") Application.ScreenUpdating = False ChDir Pfad Do While Datei "" If LCase(wbZiel.Name) LCase(Datei) Then i = i + 1 Set wbQuelle = Workbooks.Open(Filename:=Pfad & Datei, ReadOnly:=True) LetztesBlatt = wbQuelle.Sheets.Count Set wksQuelle = wbQuelle.Sheets(LetztesBlatt) wksQuelle.Unprotect 'erforderlich ? wksQuelle.Cells(1, 4).Copy wksZiel.Cells(1 + i, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ _ :=False, Transpose:=False wksQuelle.Cells(5, 12).Copy wksZiel.Cells(1 + i, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ _ :=False, Transpose:=False Application.CutCopyMode = False wbQuelle.Close savechanges:=False End If Datei = Dir() Set wbQuelle = Nothing: Set wksQuelle = Nothing Loop wbZiel.Activate wksZiel.Activate 'wksZiel.Columns.AutoFit Application.ScreenUpdating = True End Sub

Hallo Franz,
vielen Dank für die hilfreichen Verbesserungsvorschläge. So weit gut nachvollziehbar.
Funktionieren tut es leider nicht.
Die workbooks werden angesprochen und auch die Zielzellen werden nach und nach aktiviert, bleiben aber leer (egal ob Einzelschritte oder autom. Durchlauf.
Beim Debuggen wird das Quell-Workbook korrekt angesprochen aber -zumindest nicht sichtbar- das letzte worksheet aktiviert und auch die Quellzellen werden nicht sichtbar angesprungen (blinkender Rahmen um die kopierte Zelle). Vielleicht läuft das ja im Hintergrund !?
(Ich hatte zuvor schon einmal eine verkürzte Form ansatzweise angewandt, bin dann aber wieder zur Select-copy-Weise zurück, weil es nur so funktionierte.
Hast Du eine Idee woran es liegen könnte? Kann eine falsche Excel-Konfiguration die Ursache sein?
Gruß
Peter

'Letztes sichtbares Blatt ermitteln Do Set wksQuelle = wbQuelle.Sheets(LetztesBlatt) If wksQuelle.Visible = xlSheetVisible Then Exit Do LetztesBlatt = LetztesBlatt - 1 Loop wksQuelle.Unprotect 'erforderlich ? 'Test-Zeile MsgBox "Name Quelldatei: " & wbQuelle.Name & vbLf _ & "Name Tabelle: " & wksQuelle.Name & vbLf _ & "Zelladresse1: " & wksQuelle.Cells(1, 4).Address & vbLf _ & "ZellWert: " & wksQuelle.Cells(1, 4).Value & vbLf _ & "Zelladresse2: " & wksQuelle.Cells(5, 12).Address & vbLf _ & "ZellWert: " & wksQuelle.Cells(5, 12).Value, vbOKOnly, "Informationen Quelle" wksQuelle.Cells(1, 4).Copy

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread