Format mit variabler Zeile kopieren
13.03.2018 12:14:50
Kai
ich habe einen Code geschrieben, der mir Daten ans Ende einer Tabelle in einer anderen Datei schreibt. Das Problem liegt darin, daß ich das Format der letzten beschriebenen Zeile kopieren und eine Zeile tiefer einfügen möchte. Ich habe alle Möglichkeiten, die ich gefunden habe, ausprobiert. Teste ich den Code zum Format kopieren in einer separaten Tabelle, funktioniert es. Eingefügt in den bestehenden Code bekomme ich die Meldung "Laufzeitfehler '1004', Die Methode Range für das Objekt'_Worksheet' ist fehlgeschlagen".
Der fehlerhafte Teil ist fett markiert.
Wer kann mir helfen?
Option Explicit
Private Sub CommandSpeichern_Click()
Dim strPN As String
Dim lngPN As Long
Dim wksLF As Worksheet
Dim wksW As Worksheet
Dim wbkQ As Workbook
Dim wbkZ As Workbook
Dim wksZ As Worksheet
Dim i As Integer
Dim strWerk As String
Dim strMat As String
Dim strName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Variablen deklarieren
Set wksLF = Worksheets("Elution_pH_el. LF")
Set wksW = Worksheets("W")
Set wbkQ = ActiveWorkbook
Application.Workbooks.Open "Z:\XXXX\01 Prüfberichte (ausgefüllt)\2012 Projekt Leitfä _
_
higkeit\0000000 Übersicht Probennahmen Projekt LF.xlsx"
Set wbkZ = ActiveWorkbook
Set wksZ = wbkZ.Worksheets("Übersicht PN LF")
strPN = wksW.Range("B8").Text
strName = strPN & " W pH LF.xlsm"
i = wksZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
strWerk = wksW.Cells(5, 2).Value
strWerk = Mid(strWerk, 7, 3)
strMat = wksW.Cells(5, 2).Value
strMat = Left(strMat, 9)
'Probennummer prüfen
'PN vorhanden?
If IsEmpty(wksW.Range("B8").Value) = True Then
MsgBox "Bitte Probennummer eingeben!"
Exit Sub
End If
'PN im richtigen Bereich?
lngPN = wksW.Range("B8").Value
If lngPN 199999 Then
MsgBox "Bitte Probennummer überprüfen!"
Exit Sub
End If
'Daten übertragen
With wksZ
.Cells(i, 1) = wksW.Cells(7, 2).Value
.Cells(i, 2) = wksW.Cells(8, 2).Value
.Cells(i, 3) = strWerk
.Cells(i, 4) = wksW.Cells(6, 2).Value
.Cells(i, 5) = "PN 8/11, " & strMat
.Cells(i, 9) = wksW.Cells(19, 6).Value
End With
'Format kopieren
i = i - 1
wksZ.Range(Cells(i, 1), Cells(i, 15)).Copy
i = i + 1
wksZ.Range(Cells(i, 1), Cells(i, 15)).PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
'Hyperlink einfügen
wksZ.Hyperlinks.Add anchor:=wksZ.Cells(i, 11), Address:="Z:\XXXX\01 Prüfberichte ( _
_
ausgefüllt)\2012 Projekt Leitfähigkeit\Prüfberichte\" & strName, TextToDisplay:=strName
wksLF.Activate
'Datei speichern
wbkQ.SaveAs Filename:="Z:\XXXX\01 Prüfberichte (ausgefüllt)\2012 Projekt Leitfä _
higkeit\Prüfberichte\" & strPN _
& " W pH LF", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
wbkZ.Close True
UserForm02.Show
End Sub
Gruß
Kai