Hallo KoMo,
Nimm mal lieber diesen Code. Damit werden auch Artikel aufgelistet, bei denen kein Bild hinterlegt ist. Außerdem werden Zeilen- und Spaltenbreite des Zielblattes an die Bildverhältnisse angepasst.
Sub BilderOrdnen()
Dim oldcell As Range
Set tbl1 = Sheets("Tabelle1") 'Quelldaten
Set tbl2 = Sheets("Tabelle3") 'Zieldaten
For Each p In tbl1.Pictures
altartikel = artikel
artikel = p.TopLeftCell.Offset(0, -1)
If artikel <> altartikel Then
counter = 0
If oldcell Is Nothing Then Set oldcell = p.TopLeftCell.Offset(0, -1)
If p.TopLeftCell.Offset(0, -1).Row > oldcell.Row + 1 Then
For i = oldcell.Row + 1 To p.TopLeftCell.Offset(0, -1).Row - 1
tbl2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Offset(1, 0) = tbl1.Cells(i, 1)
Next i
End If
End If
Set oldcell = p.TopLeftCell.Offset(0, -1)
p.Copy
Set c = tbl2.Range("A:A").Find(artikel)
counter = counter + 1
If c Is Nothing Then
Set c = tbl2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Offset(1, 0)
counter = 1
End If
c.Value = artikel
tbl2.Activate
If Rows(c.Row).Height <= p.Height Then Rows(c.Row).RowHeight = p.Height
c.Offset(0, counter).Select
If Columns(c.Offset(0, counter).column).Width < p.Width Then
Columns(c.Offset(0, counter).column).ColumnWidth = GetColumnWidth(p.Width)
End If
tbl2.Paste
Selection.Top = c.Top
Selection.Left = c.Offset(0, counter).Left
Next p
End Sub
Function GetColumnWidth(Width As Single)
GetColumnWidth = Columns(1).ColumnWidth / Columns(1).Width * Width
End Function
Gruß Mr. K.