Hi Pa,
< könntest Du mir bitte noch zeigen wie ich jetzt prüfe
< ob die Zeile aus der Zieldatei schon befüllt ist
da gibts so viele Varianten wie Philosophen ;)
ich bevorzuge:
LetzteZeile = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
NächsteLeereZeile = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row + 1
in deinem Code also : WsTarget.Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row + 1
Gruß H27
PS: Apropos Philo ;) - zum Vergleich schreibe ich die ganze Aufgabe kürzer so :
Option Explicit
Sub myCopyValue4Turnover()
'***************************************************************************
Rem damit Code net so breit wird kürzere Variable
Const StrPath As String = "D:\LB_Offline\LB_2014\Umsatzliste.xlsm" 'FullPath
'Quell Datei ist die aktive Mappe, nur das Arbeitsblatt
Dim sSh As Worksheet 'Register1 "LB Offline"
'Arbeitsblatt der Zieldatei
Dim tSh As Worksheet 'Register1 "2014"
Dim lstCell As Range 'letze beschiebene Zelle in [A:A]
Dim v As Long 'für Abfrage
'--------------------------
'Zuweisung Quelle
Set sSh = Sheets("LB Offline")
'-----------------
'Zieldatei öffnen - richtiges Register
Set tSh = Application.Workbooks.Open(StrPath).Sheets("2014")
Set lstCell = tSh.Cells(Rows.Count, 1).End(xlUp)
'--------------------------------
'Abfrage überschreiben / anhängen
Select Case MsgBox("Zeile anfügen - ja" & Chr(13) & _
"Zeile überschreiben - wenn nein" & Chr(13) & _
"oder Abbruch", vbYesNoCancel, _
"Wohin mit den Daten")
Case 2
GoTo errorhandler
Case 7
'wird überschrieben
Case 6
Set lstCell = lstCell.Offset(1, 0)
End Select
'---------------
'werte schreiben
lstCell.Value = sSh.[LBvalKDNr].Value 'Kundennummer
lstCell.Offset(0, 1).Value = sSh.[LBvalKDName].Value 'Kunde
lstCell.Offset(0, 2).Value = sSh.[LBvalAP].Value 'Ansprechpartner
lstCell.Offset(0, 3).Value = sSh.[LBvalAPmail] 'Ansprechpartner eMail
lstCell.Offset(0, 4).Value = sSh.[B55].Value 'Summe Gesamtpreis
lstCell.Offset(0, 5).Value = sSh.[F33].Value 'Datum der ausgestellten Leistungsbestätigung
lstCell.Offset(0, 6).Value = sSh.[F37].Value 'Gesamtpreis Anreisepauschale
lstCell.Offset(0, 7).Value = sSh.[F38].Value 'Gesamtpreis Übernachtungspauschale
errorhandler:
'--------------------------------
'Abfrage Schließen / Speichern
Select Case MsgBox("Speichern - ja" & Chr(13) & _
"Speichern - nein" & Chr(13) & _
"oder Abbruch", vbYesNoCancel, _
"Schließen / Speichern")
Case 2
Exit Sub
Case 7
Application.DisplayAlerts = Not Application.DisplayAlerts
ActiveWorkbook.Close
Application.DisplayAlerts = Not Application.DisplayAlerts
Case 6
ActiveWorkbook.Save
ActiveWorkbook.Close
End Select
End Sub
|