Hallo,
ich bastel gerade an nachfolgendem Script.
Dieses schreibt Kundendaten in eine andere Datei, in der die Kunden Zeile für Zeile aufgelistet sind.
Nun soll aber vorher überprüft werden, ob der Kundenname in der gesamten Spalte C bereits vorkommt.
Falls ja, soll das Programm noch in der Spalte I überprüfen, ob auch die Emailadresse identisch ist.
Ist das der Fall, soll das Programm die Kunden-Nummer (in der ersten Spalte) aus der entsprechenden Datei in Zelle C3 / Sheet Kalkulation / Datei Auftragsbearbeitung-19 übertragen.
Ist das nicht der Fall, kann das Script wie unten durchlaufen, weil ja dann der Kunde automatisch angelegt wird.
Wer kann mir also sagen, wie ich diese Abfrage in 2 Spalten bewerkstellige um dann zu entscheiden,
ob ein Kunde in einer Zeile neu angelegt wird, oder aber nur eine bereits vergebene Kundennummer gezogen wird.
Ich freue mich auf eine Antwort.
Gruß
Sub Auftragsdaten_vorbereiten()
'Übertragen der Daten in die Datenbank
Paul = (Sheets("Kalkulation").[l4] & " - " & [l9] & " - " & [n1] & ".xls")
Paul = ActiveWorkbook.Name
ChDir "x:\"
Workbooks.Open Filename:="x:\Datenbank.xls", _
UpdateLinks:=0
Sheets("Kunden").Activate
Range("A2").Select
Cells(Rows.Count, 2).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, -1).Copy
Windows(Paul).Activate
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Kalkulation").Select
Range("C3").Select
ActiveSheet.Paste
Selection.Interior.ColorIndex = 40
Selection.Borders(xlLeft).LineStyle = xlNone
Selection.Borders(xlRight).LineStyle = xlNone
Selection.Borders(xlTop).LineStyle = xlNone
With Selection.Borders(xlBottom)
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.BorderAround Weight:=xlThin, ColorIndex:=xlAutomatic
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Bestelldaten aufbereitet").Select
Range("D1").Select
Selection.Copy
Windows("Datenbank.xls").Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows(Paul).Activate
Sheets("Bestelldaten aufbereitet").Select
Range("D2").Copy
Windows("Datenbank.xls").Activate
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows(Paul).Activate
Sheets("Bestelldaten aufbereitet").Select
Range("d3").Copy
Windows("Datenbank.xls").Activate
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows(Paul).Activate
Sheets("Bestelldaten aufbereitet").Select
Range("d4").Copy
Windows("Datenbank.xls").Activate
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows(Paul).Activate
Sheets("Bestelldaten aufbereitet").Select
Range("d5").Copy
Windows("Datenbank.xls").Activate
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows(Paul).Activate
Sheets("Bestelldaten aufbereitet").Select
Range("d6").Copy
Windows("Datenbank.xls").Activate
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows(Paul).Activate
Sheets("Bestelldaten aufbereitet").Select
Range("d7").Copy
Windows("Datenbank.xls").Activate
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.ScreenUpdating = True
ActiveCell.Offset(0, -36).Select
MsgBox "so o.k. ?"
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows(Paul).Activate
Sheets("Bestelldaten aufbereitet").Select
Range("D13").Select
Selection.Copy
Sheets("Kalkulation").Select
Range("M17").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("c3").Select
Application.Run "'Auftragsbearbeitung-19.xls'!Schaltfläche2_BeiKlick"
Application.ScreenUpdating = False
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Bestelleingang").Select
Range("D17").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Kalkulation").Select
Range("C3").Select
End Sub