Werte von Sheet1 in Sheet2 in passende Zeile übertragen

[Mitness]

Moin liebe Community,

ich schlage mich seit Anfang vom Wochenende mit einem Problem rum, und zwar:

Ich sammel über den Tag in Sheet1 wie oft ein Produkt hergestellt wurde und zähle diese per "+" und "-" Button(Makro) hoch oder runter. Am Ende des Tages werden die gesammelten Werte in Sheet2 mittels Makro übergeben in die korrekte Spalte der aktuellen KW. Jetzt macht mir folgendes Szenario Schwierigkeiten:
Wenn in Sheet1, aus welchem Grund auch immer, zwei Zeilen vertauscht werden oder ein Produkt geändert wird, legt das Makro in Sheet2 die Werte nicht dem passenden Produkt zu, sondern einfach nur von oben nach unten. Wie kann ich realisieren, dass die Werte in jedem Fall auch zu dem passenden Produkt abgelegt werden?

Ich hoffe ich konnte mein Problem verständlich erklären, falls nicht gerne Nachfragen. Bei Bedarf kann ich auch die Excel zur Verfügung stellen.

Liebe Grüße
Mitness
   
   

[schauan]

Hallöchen,

a)
sortiere vor der Übertragung
b)
suche die korrekte Zeile, code zum Suchen kann man aufzeichnen

[volti]

Hallo,

falls noch Bedarf besteht ohne Sortierung die Daten zu übertragen, teste mal folgendes Makro als Anregung:

Code:

Sub Übertragen()
  Dim vArr() As Variant, WShQ As Worksheet
  Dim iGefunden As Long, iKW As Integer, iZeile As Long
 
  iKW = 5                                              ' Woche vorgeben
  
  Set WShQ = Sheets("Tabelle2")                        ' Quelltabelle
  With Sheets("Tabelle1")
     ReDim vArr(.Cells(Rows.Count, "A").End(xlUp).Row) ' Array dimensionieren
  
     On Error Resume Next
     For iZeile = 2 To UBound(vArr)                    ' Alle Zelen durchgehen
         iGefunden = 0
         iGefunden = WorksheetFunction.Match(.Cells(iZeile, 1).Value, WShQ.Range("A:A"), 0)
         If iGefunden > 0 Then                         ' Suchbegriff gefunden?
            vArr(iZeile - 2) = WShQ.Cells(iGefunden, "B").Value
         End If
     Next iZeile
     .Cells(2, iKW + 1).Resize(UBound(vArr) - 1, 1).Value _
            = Application.Transpose(vArr)              ' Daten ausgeben
  End With
End Sub

_________
viele Grüße
Karl-Heinz