Hallo Silvi,
hier zwei Varianten, die Daten per Makro von Blatt 1 nach Blatt 2 zu übertragen.
Variante 1 prüft ob in Zeile 4 in den Spalten 77 bis 83 ein Wert steht und ob zum Artikel dafür ein Betrag >0 eingetragen ist. Sind beide Bedingungen war, dann werden die Werte übertragen.
In Variante 2 werden die Spalten fest vorgegeben, deren Werte ins Blatt 2 übertragen werden sollen.
Gruß
Franz
Sub DatenUmgruppierenVariante1()
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim ZeileQ As Long, ZeileZ As Long
Dim varArtikelNr As Variant
Dim intSpalte As Integer
Const varSpalteA = 44 'Fester Wert in Spalte A
Const varSpalteB = 6 'Fester Wert in Spalte B
Const lngZeileKST = 4 'Zeile mit den Nummern, die in Spalte D eingetragen werden sollen
Set wksQuelle = Worksheets("Tabelle1") 'Tabelle mit Ausgangsdaten
Set wksZiel = Worksheets("Tabelle2") 'Tabelle mit umgruppierten Daten
With wksZiel
'vorhandene Daten löschen
.Range(.Columns(1), .Columns(5)).ClearContents
'Spaltentitel eintragen
.Cells(1, 1) = "A"
.Cells(1, 2) = "B"
.Cells(1, 3) = "Artikelnummer"
.Cells(1, 4) = "Kostenstelle"
.Cells(1, 5) = "Betrag"
End With
With wksQuelle
'Zeilen in Ausgangsdaten mit Wert in Spalte A abarbeiten
ZeileZ = 2
For ZeileQ = lngZeileKST + 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Daten in Zeile einlesen
varArtikelNr = .Cells(ZeileQ, 1).Value 'Wert aus Spalte A
'Spalten 76 (BX) bis 83 (CE) in Zeile 4 prüfen
For intSpalte = 76 To 83
'Prüfen ob in Zeile 4 ein Eintrag vorhanden und bei Artikelnummer der Wert > 0
If Not IsEmpty(.Cells(lngZeileKST, intSpalte)) _
And .Cells(ZeileQ, intSpalte) "" Then
If .Cells(ZeileQ, intSpalte) > 0 Then
'Daten in Zieltabelle eintragen
wksZiel.Cells(ZeileZ, 1) = varSpalteA
wksZiel.Cells(ZeileZ, 2) = varSpalteB
wksZiel.Cells(ZeileZ, 3) = varArtikelNr
wksZiel.Cells(ZeileZ, 4) = .Cells(lngZeileKST, intSpalte) 'Kostenstelle
wksZiel.Cells(ZeileZ, 5) = .Cells(ZeileQ, intSpalte) 'Betrag
ZeileZ = ZeileZ + 1
End If
End If
Next
Next
End With
With wksZiel
.Activate
'Daten nach Artikelnummer, Kostenstelle sortieren
.Range(.Columns(1), .Columns(5)).Sort _
Key1:=.Cells(1, 3), Order1:=xlAscending, _
Key2:=.Cells(1, 4), Order2:=xlAscending, Header:=xlYes
End With
Set wksQuelle = Nothing: Set wksZiel = Nothing
End Sub
Sub DatenUmgruppierenVariante2()
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim ZeileQ As Long, ZeileZ As Long
Dim varArtikelNr As Variant
Dim intSpalte As Integer
Const varSpalteA = 44 'Fester Wert in Spalte A
Const varSpalteB = 6 'Fester Wert in Spalte B
Const lngZeileKST = 4 'Zeile mit den Nummern, die in Spalte D eingetragen werden sollen
Set wksQuelle = Worksheets("Tabelle1") 'Tabelle mit Ausgangsdaten
Set wksZiel = Worksheets("Tabelle2") 'Tabelle mit umgruppierten Daten
With wksZiel
'vorhandene Daten löschen
.Range(.Columns(1), .Columns(5)).ClearContents
'Spaltentitel eintragen
.Cells(1, 1) = "A"
.Cells(1, 2) = "B"
.Cells(1, 3) = "Artikelnummer"
.Cells(1, 4) = "Kostenstelle"
.Cells(1, 5) = "Betrag"
End With
With wksQuelle
'Zeilen in Ausgangsdaten mit Wert in Spalte A abarbeiten
ZeileZ = 2
For ZeileQ = lngZeileKST + 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Daten in Zeile einlesen
varArtikelNr = .Cells(ZeileQ, 1).Value 'Wert aus Spalte A
'Spalten 76 (BX) bis 83 (CE) in Zeile 4 prüfen
For intSpalte = 76 To 83
'Spalten vorgeben deren Werte übertragen werden sollen
Select Case intSpalte
Case 77, 79, 80, 83 'KST 271040, 271030, 271010, 271060
'Daten in Zieltabelle eintragen
wksZiel.Cells(ZeileZ, 1) = varSpalteA
wksZiel.Cells(ZeileZ, 2) = varSpalteB
wksZiel.Cells(ZeileZ, 3) = varArtikelNr
wksZiel.Cells(ZeileZ, 4) = .Cells(lngZeileKST, intSpalte) 'Kostenstelle
wksZiel.Cells(ZeileZ, 5) = .Cells(ZeileQ, intSpalte) 'Betrag
ZeileZ = ZeileZ + 1
Case Else
'do nothing
End Select
Next
Next
End With
With wksZiel
.Activate
'Daten nach Artikelnummer, Kostenstelle sortieren
.Range(.Columns(1), .Columns(5)).Sort _
Key1:=.Cells(1, 3), Order1:=xlAscending, _
Key2:=.Cells(1, 4), Order2:=xlAscending, Header:=xlYes
End With
Set wksQuelle = Nothing: Set wksZiel = Nothing
End Sub