Makro Korrektur

Hallo Zusammen,
ich brauch mal wieder eure Hilfe,
Ich habe ein Makro welches mich fragt in welchem Ordner Exceldateien liegen welche ich bearbeiten will. Diese werden dann geöffnet und im SheetA in einem von mir definiertem Bereich von A7:A12 wird die letzte freie Zelle gesucht und dann der Wert von der darüberliegenden Zelle +1 eingetragen. Leider klappt es nicht, das das Makro zu dem SheetA springt. Mag sich das mal einer anschauen und Optimieren?

Sub neuesJahr()
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Verzeichnis mit den Excel-Dateien auswählen, die " _
& "ergänzt werden sollen"
If .Show = -1 Then
varVerzeichnis = .SelectedItems(1)
Else
Exit Sub
End If
End With
strDatei = Dir(varVerzeichnis & "\*.xls*")
If strDatei = "" Then
MsgBox "Keine Excel-Dateien im gewählten Verzeichnis"
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Do Until strDatei = ""
With Application.Workbooks.Open( _
Filename:=varVerzeichnis & "\" & strDatei, _
ReadOnly:=False, UpdateLinks:=False)
Workbook.Unprotect
Sheets("SheetA").Select
Set Bereich = Range("A7:A12")
Set Bereich2 = Range("A7:A12")
Bereich.Cells(1, 1).End(xlDown).Offset(1, 0).Select
ActiveCell.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromAbove
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Bereich2.Cells(1, 1).End(xlDown).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "0"
Selection.NumberFormat = "0%"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWorkSheet.Protect
ActiveWorkbook.Save
ActiveWorkbook.Close
End With
Loop
End Sub

Danke für eure Hilfe vorab.
Freundliche Grüße
Steffen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

…Steffen:

With Application.Workbooks.Open(Filename:=varVerzeichnis & "\" & strDatei, _
ReadOnly:=False, UpdateLinks:=False)
Workbook.Unprotect

Dem folgt endlos später direkt vor Loop tatsächlich noch ein End With, aber wie auch Rudi schrieb, das so festgelegte Workbook-Objekt nutzt du gar nicht, wie schon der nächste, noch dazu falsche Befehl beweist! Außerdem wäre wohl in diesem Fall das Setzen einer neuen ObjektReferenz sinnvoller.
Das Workbook-Objekt hat zwar auch eine .[Un]Protect-Eigenschaft, aber dann eben ein bestimmtes und man sollte ein (ggf leeres) Passwort und was geschützt wdn soll angeben. Falls das so bleiben soll, hier also nur .Unprotect schreiben, was aber nicht den Blattschutz aufhebt. Es ist auch meist besser, wenn man den Zugriff von Pgmm auf die Blätter zulassen will, aber dem User bestimmte Eingriffe nicht, mit dem .Protect-Parameter UserInterfaceOnly:=True zu arbeiten.
Selection ist ein allgemeines Objekt, das vom VBE-Intellisense nicht unterstützt wird, weil es alles mögliche sein kann. Es ist also besser, direkt mit dem eigentlichen Objekt zu arbeiten.
Gruß, Luc :-?

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread