Antwort
08.07.2023 14:51:57
siegfried b
Hallo Piet,
hier das Makro:
Dim wksQUELLE As Worksheet 'Quell-Worksheet
Dim wksZIEL As Worksheet 'Ziel-Worksheet
Dim wkbZIEL As Workbook, wkbQUELLE As Workbook
Dim rngZIEL As Range
Dim strSUCH As String
Const cstr_wkbQUELLE As String = "Werkstatt.xlsm"
Const cstr_wksQUELLE As String = "Daten"
Set wkbQUELLE = ActiveWorkbook
Set wksQUELLE = ActiveSheet
On Error Resume Next
Set wkbZIEL = Workbooks(cstr_wkbQUELLE)
On Error GoTo 0
If wkbZIEL Is Nothing Then
Set wkbZIEL = Workbooks.Open("D:\" & cstr_wkbQUELLE)
End If
'Worksheet-Variable setzen
Set wksZIEL = wkbZIEL.Worksheets(cstr_wksQUELLE)
Dim lFile
Dim lloRow As Long, ldtRgDate As Date, lstrRgNr As String, lboOK As Boolean, lloRNext As Long
Dim wks, shs, pshDB
' Application.EnableEvents = False
Application.ScreenUpdating = False
wkbZIEL.Activate
wkbQUELLE.Activate
Dim lngCt As Long
If Not IsEmpty(wksQUELLE.Range("K11")) Then 'meine offene Datei und der aktiven Sheet in K11 steht immer die Nummer / Text drin
lngCt = WorksheetFunction.CountIf(wksQUELLE.Range("A3:A" & wksQUELLE.Rows.Count), wksQUELLE.Range("K11").Value)
End If
If lngCt > 0 Then
MsgBox "Kundennummer schon vorhanden"
wkbZIEL.Close True
Exit Sub
End If
Else
MsgBox "Nummer fehlt"
MsgBox "Daten werden jetzt übertragen"
End If
End If
' wenn fehlt soll es weiter gehen, mit kopieren
wksQUELLE.Range("K11:K22").Copy
rngZIEL.Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
mfg siegfried b