Laufzeitfehler 13
06.02.2019 14:10:26
Teom
Sub Daten_nach_Extern()
Dim wksQ As Worksheet
Dim wkbZ As Workbook
Dim wksZ As Worksheet
Dim ZeileZ As Long
Dim strPfad As String
Dim strDatei As String
Set wksQ = ActiveSheet
'Verzeichnis der Zieldatei
strPfad = "C:\Users\Private\Desktop\ImportDateien\TestOrdner"
'Name der Zieldatei
strDatei = "ImportSheet1Ziel.xlsx"
If Dir(strPfad & "\" & strDatei) = "" Then
MsgBox "Datei " & vbLf & strPfad & "\" & strDatei & vbLf & "nicht gefunden"
Else
'//Makrobremsen fängt an zu arbeiten
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'//Zieldatei öffnen
Set wkbZ = Application.Workbooks.Open(Filename:=strPfad & "\" & strDatei)
Set wksZ = wkbZ.Worksheets("Sheet1")
With wksZ
'nächste Zeile ohne Daten in Spalte A.
Zeile_Z = .Cells(.Rows.Count, 1).End(xlUp).Rows + 1
'alternativ nächste nicht benutzte Zeile
Zeile_Z = .UsedRange.Row + .UsedRange.Rows.Count
'Daten übertragen ohne Bedingungen
Spalte = 2 '= Spalte A
.Cells(ZeileZ, Spalte) = wksQ.Range("C18").Value
'// erst Auditsheet, dann Ziel angeben
'Spalte = 3: .Cells(ZeileZ, Spalte).Value = "Yes"
Spalte = 4: .Cells(ZeileZ, Spalte) = wksQ.Range("C9").Value
Spalte = 5: .Cells(ZeileZ, Spalte) = wksQ.Range("C17").Value
'.usw.
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCac
.EnableEvents = True
End With
End If
End Sub