plötzliche Laufzeitprobleme
29.07.2020 15:28:05
Andreas
leider habe ich ein Problem was seit gerade auftritt. Bis dato hat der Codeschnipsel tadellos funktioniert.
Auch die Dateien haben sich nicht geändert. Vielleicht habt Ihr eine Idee woran das liegen könnte?
Der Code läuft sonst ohne Probleme durch. Habe im unten stehenden Code die Zeile ab der der Laufzeitfehler kommt fett markiert.
VIelen Dank schonmal vorab für eure Mühen.
Gruß
Andreas
Option Explicit
Public Sub Daten_Rechnungen_holen()
Dim wbQuelle As Workbook, wsQuelle As Worksheet
Dim strPfad As String, strBlattname As String
Dim loLetzte As Long, loSuchbegriff As Long
Dim boVorhanden As Boolean
'### Deinen Pfad hier anpassen #####
strPfad = "\\NAS-2T\fibu\"
strBlattname = ActiveSheet.Name & " " & Right(Range("J3"), 2)
loSuchbegriff = ActiveSheet.Range("J1")
Application.ScreenUpdating = False
'Zielbereich leeren
With ActiveSheet
loLetzte = .Cells(.Rows.Count, 15).End(xlUp).Row
If loLetzte >= 4 Then
.Range(.Cells(4, 15), .Cells(loLetzte, 20)).ClearContents
End If
End With
'Datei Ausgangsrechnungen öffnen
Set wbQuelle = Workbooks.Open(strPfad & "Ausgangsrechnungen_rev2.7.xlsx")
With wbQuelle
'richtiges Quellblatt wählen
For Each wsQuelle In .Worksheets
If wsQuelle.Name = strBlattname Then
boVorhanden = True
'Quellblatt nach Kostenstelle filtern
With Worksheets(wsQuelle.Name)
loLetzte = .Cells(.Rows.Count, 5).End(xlUp).Row
.Range("$A$4:$T$" & loLetzte).AutoFilter Field:=5, Criteria1:=loSuchbegriff
loLetzte = .Cells(.Rows.Count, 5).End(xlUp).Row
If loLetzte """";P9;Q9)"
.Range(.Cells(9, 20), .Cells(loLetzte, 20)).Copy
.Range("M9").PasteSpecial Paste:=xlPasteValues
.Range(.Cells(9, 16), .Cells(loLetzte, 20)).ClearContents
End With
'Quellblatt ohne speichern schließen
wbQuelle.Close (False)
Application.CutCopyMode = False
End With
End If
End With
Exit For
End If
Next wsQuelle
End With
If Not boVorhanden Then
'MsgBox "Es ist kein Tabellenblatt " & """" & strBlattname & """" & " in Ausgangsrechnung _
vorhanden."
wbQuelle.Close (False)
End If
Dim cell As Range
For Each cell In Columns(11).SpecialCells(xlCellTypeConstants, 1 + 2)
With cell
If IsEmpty(cell) = False Then
.Offset(0, 3).NumberFormat = "DD.MM.YYYY" 'Format(Date, "General Date") Col N
.Offset(0, 3).HorizontalAlignment = xlCenter
.Offset(0, 4).Style = "Currency" 'Col O
.Offset(0, 2).HorizontalAlignment = xlLeft
With .Resize(, 5)
.Interior.Color = RGB(217, 217, 217)
.Font.Size = 12
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlMedium
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End If
End With
Next cell
Range("K1:O1").EntireColumn.AutoFit
Set wbQuelle = Nothing
Application.ScreenUpdating = True
End Sub