Dazu Summieren

Public Sub Update()

Dim obj_wkb_ziel As Workbook

Dim obj_wkb_quelle As Workbook

Dim obj_wks_quelle As Worksheet

Dim obj_wks_ziel As Worksheet

Dim lng_zeile_ziel As Long

Dim rng_fund As Range

Dim AC As Range   'ActiveCell

Dim n As Integer  'Fehlerzähler



Set obj_wkb_ziel = ThisWorkbook

Set obj_wks_ziel = obj_wkb_ziel.Worksheets("Zieldatei")   ' Blattname ggf. ändern



Set obj_wkb_quelle = Workbooks.Open("\\eden-file\Ordnerumleitung\shsq\Desktop\Quelldatei.xlsx")

'Set obj_wkb_quelle = Workbooks.Open("\\eden-file\Ordnerumleitung\shsq\Desktop\Quelldatei.xlsx")  ' Pfad und Dateiname ggf. anpassen

Set obj_wks_quelle = obj_wkb_quelle.Worksheets("DIAS") ' Blattname ggf. anpassen



Application.ScreenUpdating = False



With obj_wks_ziel

     lng_zeile_ziel = .Cells(Rows.Count, 1).End(xlUp).Row

     .Range("B2:H" & lng_zeile_ziel).ClearContents

     Application.ScreenUpdating = False

      

     'Schleife in Zieldatei sucht Artikel Nr. in Quelldatei

     For Each AC In .Range("A2:A" & lng_zeile_ziel)

        Set rng_fund = obj_wks_quelle.Columns(1).Find(AC, LookIn:=xlFormulas, lookat:=xlWhole)

        If Not rng_fund Is Nothing Then

           '3 Spalten kopieren bis Spalte "DIAS"

           rng_fund.Offset(0, 6).Resize(1, 3).Copy

           AC.Offset(0, 1).PasteSpecial xlPasteValues

           '3 Spalten nach "DIAS" kopieren

           rng_fund.Offset(0, 10).Resize(1, 3).Copy

           AC.Offset(0, 4).PasteSpecial xlPasteValues

        Else

           AC.Offset(0, 7) = "No Find":  n = n + 1

        End If

      Next AC

End With



Application.CutCopyMode = False

If n > 0 Then MsgBox n & "  Daten nicht gefunden"



Set obj_wks_ziel = Nothing

Set obj_wks_quelle = Nothing



Set obj_wkb_quelle = Nothing

Set obj_wkb_ziel = Nothing



Application.ScreenUpdating = True

End Sub