AW: Daten übertragen via Makro
06.07.2018 21:15:33
Barbaraa
Hallo Mike,
Probier mal das:
Kopiere diesen Code in ein neues Modul:
Option Explicit
Public wErf As Range
Public wDat As Range
Public lDatZei As Long
Sub Mike_Makro1_0706()
' Daten übertragen und am der Ende der Tabelle anfügen. [von A10 bis I10]
Dim lErfSp As Long
Set wErf = Worksheets("Erfassung").Cells
Set wDat = Worksheets("Daten").Cells
lDatZei = wDat(1, 1).End(xlDown).Row + 1
KundensatzSchreiben
DatensatzSchreiben
End Sub
Sub Mike_Makro2_0706()
' Daten übertragen und vorhandenen Datensatz mit identischer Nr. oder
' Kundennummer überschreiben. [von A10 bis I10] Die Kundennummer hat Vorrang.
' Falls nicht vorhanden, die Nr. verwenden.
Dim lErfSp As Long
Dim Fund
Set wErf = Worksheets("Erfassung").Cells
Set wDat = Worksheets("Daten").Cells
Fund = Application.Match(wErf(10, 2), wDat.Columns(2), 0)
If IsError(Fund) Then
Fund = Application.Match(wErf(10, 1), wDat.Columns(1), 0)
If IsError(Fund) Then
MsgBox "Weder Nr. noch Kundennummer vorhanden."
Exit Sub
End If
End If
lDatZei = Fund
KundensatzSchreiben
DatensatzSchreiben
End Sub
Sub Mike_Makro3_0706()
' Daten übertragen und alle Datensätze mit identischen Vertrag und Kategorie
' überschreiben. [nur von G10 bis I10]
Dim lErfSp As Long
Set wErf = Worksheets("Erfassung").Cells
Set wDat = Worksheets("Daten").Cells
For lDatZei = 2 To wDat(1, 1).End(xlDown).Row
If wErf(10, 3) = wDat(lDatZei, 3) And wErf(10, 6) = wDat(lDatZei, 6) Then
DatensatzSchreiben
End If
Next lDatZei
End Sub
Private Sub DatensatzSchreiben()
Dim lErfSp As Long
For lErfSp = 7 To 9
wDat(lDatZei, Application.Match(wErf(9, lErfSp), wDat.Rows(1), 0)) _
= wErf(10, lErfSp)
Next lErfSp
End Sub
Private Sub KundensatzSchreiben()
Dim lErfSp As Long
For lErfSp = 1 To 6
wDat(lDatZei, lErfSp) = wErf(10, lErfSp)
Next lErfSp
End Sub
Zu Makro 2:
Falls eine Kundennummer gefunden wurde, wird nicht auch noch die Nr. verglichen.
Es wird nur die erste gefundene Zeile befüllt.
Weitere gleiche Kundennummern oder Nr. werden NICHT befüllt.
Aufruf der Makros:
Menü Ansicht, dann ganz rechts "Makros". Bitte recherchiere selbst, wie man einen Button erstellt, der ein Makro aufruft.
Achtung: Mir ist aufgefallen, dass manche Zeilen in Daten KEINE Formeln hinterlegt haben.
Du schreibst: "Vorab vielen Dank".
Ich antworte: Bitte gern geschehen.
LGB