Hallo VBA Profis,
bin mal wieder auf Problem gestoßen, welches ich selbst nicht lösen kann. Wäre toll, wenn mir hier jemand weiterhelfen könnte. Schon mal Besten Dank dafür.
Hier der Quellcode...Fehler erscheint bei der Zeile die mit *** gekennzeichnet ist.
Sub TN_einlesen()
Dim sPfad As String
Dim wbQuelle As Workbook
'ScreenUpdating und PopUps deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Dateipfad der Quelldatei
sPfad = Environ("userprofile") & "\Nextcloud\Betriebe\xxxx\Taetigkeitsnachweis\gbu_taetigkeitsnachweis.xlsm"
'Prüfen, ob Datei existiert
If Dir(sPfad) > "" Then
'Arbeitsmappe öffnen
Set wbQuelle = Workbooks.Open(sPfad)
wbQuelle.Worksheets(2).Range("K30").Copy
Workbooks("gbu_rechnung.xlsm").Activate
Worksheets("Rechnung").Unprotect
End If
Dim test As Range
'***********hier erhalte ich den Fehler "Laufzeitfehler 91....Objektvariable oder Block Variable nicht festgelegt"
test = Worksheets("Rechnung").Cells(Range("A20:R34").End(xlDown).Row, 2).Address
Dim MyObject As Object ' Create object variable.
Set MyObject = Sheets(1) ' Create valid object reference.
MyCount = MyObject.Count ' Assign Count value to MyCount.
With Worksheets("Rechnung").Range("A20:R34")
Set test = .Find(What:="", After:=.Cells(.Cells.Count), LookIn:=xlFormulas, LookAt:=xlWhole)
If Not test Is Nothing Then
MsgBox test.Address
Else
MsgBox "Keine freie Zelle im Bereich gefunden!"
End If
End With
'Cells(Rows.Count, 21).End(xlUp).Offset(1, 0).Select
With ThisWorkbook.Worksheets(2).Range("p20")
.PasteSpecial Paste:=xlValues ' Werte
.PasteSpecial Paste:=xlFormats ' Formate
.ClearFormats
End With
Worksheets(2).Range("B20").Value = "Eine Zelle"
Application.CutCopyMode = False
'Arbeitsmappe schließen
wbQuelle.Close SaveChanges:=False
Weiter:
'ScreenUpdating und PopUps aktivieren
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Worksheets("Rechnung").Protect
End Sub