Matrix 1 aus 2 befüllen anhand Spaltenüb

Hallo zusammen,
ich benötige eure Hilfe. Und zwar habe ich eine bestehende Kundenübersicht.
Im wöchentlichen Turnus ziehe ich ein Update aus SAP und aktualisiere die Daten aus diesem Update in meiner Kundenübersicht.
Allerdings hat die SAP Datei nicht immer die gleiche Spaltenanordnung, sodass ich mit dem bisher erstellten Makro nicht unbedingt arbeiten kann.
Ich habe eine Beispieldatei angefügt, mit drei Tabellenblätter. Das erste Tabellenblatt ist meine bestehende Übersicht, das zweite das erste Update, bei dem der angefügte Code noch funktioniert und das dritte Tabellenblatt stellt das zweite Update da, bei dem der Code schon nicht mehr richtig arbeiten würde, da neue Spaltenordnung.
Folgende Ergänzungen brauch ich in meinem Makro:

die Spalten sollen am besten eine Zuordnung anhand der Spaltenüberschriften haben. Also Spalte A "Branchen_Art" aus Bestand soll immer aus Spalte "Branchen_Art" aus Update befüllt werden. Wobei der Name beiden Spalten nicht immer übereinstimmt.

zudem suche ich noch nach einer Möglichkeit bei aktualisierten Daten in der Übersicht diese Zelle entsprechend hervorzuheben

In Zukunft wird nicht für jedes Update ein neues Tabellenblatt angelegt, sondern es gibt in der Excel eine Tabellenblatt "Bestand" und ein zweites Tabellenblatt "Update" in der ich die SAP Datei rüber kopiere.
Vielen Dank vorab für Eure Hilfe!

Sub Daten_uebertragen()
Debug.Print Now
Dim i As Long, Zeile As Long, letzteZeile As Long
Dim Arbeitsmappe As Workbook
Dim Datenbasis As Worksheet, Ziel As Worksheet
Dim ZelleKD_NR As Range, Bereich As Range
Set Arbeitsmappe = ThisWorkbook
Set Datenbasis = Arbeitsmappe.Worksheets("1. Update aus SAP")
Set Ziel = Arbeitsmappe.Worksheets("Bestandstabelle")
letzteZeile = Datenbasis.Range("C" & Rows.Count).End(xlUp).Row
Set Bereich = Datenbasis.Range("C2:C" & letzteZeile)
For i = 2 To Ziel.Range("C" & Rows.Count).End(xlUp).Row
    With Datenbasis
        Set ZelleKD_NR = Bereich.Find(Ziel.Range("C" & i).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not ZelleKD_NR Is Nothing Then
            Ziel.Range("A" & i).Value = .Range("A" & ZelleKD_NR.Row).Value
            Ziel.Range("B" & i).Value = .Range("B" & ZelleKD_NR.Row).Value
            Ziel.Range("D" & i).Value = .Range("D" & ZelleKD_NR.Row).Value
            Ziel.Range("E" & i).Value = .Range("E" & ZelleKD_NR.Row).Value
            Ziel.Range("F" & i).Value = .Range("F" & ZelleKD_NR.Row).Value
            Ziel.Range("G" & i).Value = .Range("G" & ZelleKD_NR.Row).Value
            Set ZelleKD_NR = Nothing
        End If
    End With
Next i
Debug.Print Now
End Sub

https://www.herber.de/bbs/user/157610.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Daten_uebertragen() Debug.Print Now Dim i As Long, Zeile As Long, letzteZeile As Long Dim Arbeitsmappe As Workbook Dim Datenbasis As Worksheet, Ziel As Worksheet Dim ZelleKD_NR As Range, Bereich As Range Dim iName As Integer, iTel As Integer, iNr As Integer, iOrt As Integer, _ iStrasse As Integer, iPLZ As Integer, iBranche As Integer, iKdNr As Integer Set Arbeitsmappe = ThisWorkbook Set Datenbasis = Arbeitsmappe.Worksheets("1. Update aus SAP") Set Ziel = Arbeitsmappe.Worksheets("Bestandstabelle") With Datenbasis For i = 1 To 8 Select Case .Cells(1, i) Case "Branchen_Art": iBranche = i Case "Firma_Name": iName = i Case "KD_NR": iKdNr = i Case "PLZ": iPLZ = i Case "Ort": iOrt = i Case "PHONE_NR": iTel = i Case "Straße": iStrasse = i Case "NR": iNr = i End Select Next i End With With Datenbasis letzteZeile = .Cells(Rows.Count, iKdNr).End(xlUp).Row Set Bereich = .Range(.Cells(2, iKdNr), .Cells(letzteZeile, iKdNr)) End With For i = 2 To Ziel.Range("C" & Rows.Count).End(xlUp).Row With Datenbasis Set ZelleKD_NR = Bereich.Find(Ziel.Range("C" & i).Value, LookIn:=xlValues, lookat:=xlWhole) If Not ZelleKD_NR Is Nothing Then Ziel.Range("A" & i).Value = .Cells(ZelleKD_NR.Row, iBranche).Value Ziel.Range("B" & i).Value = .Cells(ZelleKD_NR.Row, iName).Value Ziel.Range("D" & i).Value = .Cells(ZelleKD_NR.Row, iPLZ).Value Ziel.Range("E" & i).Value = .Cells(ZelleKD_NR.Row, iOrt).Value Ziel.Range("F" & i).Value = .Cells(ZelleKD_NR.Row, iStrasse).Value Ziel.Range("G" & i).Value = .Cells(ZelleKD_NR.Row, iNr).Value Ziel.Range("H" & i).Value = .Cells(ZelleKD_NR.Row, iTel).Value Set ZelleKD_NR = Nothing End If End With Next i Debug.Print Now End Sub

Sub Daten_uebertragen() Dim wsQ As Worksheet Dim wsZ As Worksheet Dim zKD As Range Dim SpaltenListe() As Long Dim Z As Range Dim i As Long Dim T T = Now Application.ScreenUpdating = False Application.EnableEvents = False Set wsQ = ThisWorkbook.Worksheets("1. Update aus SAP") 'Test 1 ' Set wsQ = ThisWorkbook.Worksheets("2. Update aus SAP") 'Test 2 Set wsZ = ThisWorkbook.Worksheets("Bestandstabelle") 'Column in SAP-Update finden & speichern With wsZ.Range("XFA1").End(xlToLeft) ReDim SpaltenListe(1 To .Column) For i = 1 To .Column Set Z = wsQ.Rows(1).Find(wsZ.Cells(1, i).Value, LookAt:=xlWhole) If Not Z Is Nothing Then SpaltenListe(i) = Z.Column Next End With 'für jede Eintrag in Bestandstabelle Spalte C For Each Z In Range(wsZ.Range("C2"), wsZ.Range("C999999").End(xlUp)) Set zKD = wsQ.Columns(3).Find(Z.Value, LookIn:=xlValues, LookAt:=xlWhole) 'Kd_Nr in Update suchen If Not zKD Is Nothing Then 'wenn gefunden For i = 1 To UBound(SpaltenListe) If SpaltenListe(i) > 0 Then Z.EntireRow.Cells(i) = zKD.EntireRow.Cells(SpaltenListe(i)).Value Next End If Next Application.ScreenUpdating = True Application.EnableEvents = True Debug.Print Format(T, "hh:mm:ss"), Format(Now, "hh:mm:ss"), (Now - T) * 86400 'Sekunde pro Tag End Sub

Beliebteste Forumthreads (12 Monate)

Matrix 1 aus 2 befüllen anhand Spaltenüb

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Matrix 1 aus 2 befüllen anhand Spaltenüb

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread