habe ein Problem mit nachfolgendem Makro und bitte euch zu helfen.
In dem Sonderfall, dass sowohl in Tabelle2 Spalte B und Tabelle 3 Spalte D jeweils nur ein Eintrag steht, gibt das Makro Laufzeitfehler 1004 aus, Leider konnte nichts eingefügt werden, da der Kopieren Bereich und der Einfüge Bereich nicht die gleiche Größe haben,
dabei wird beim Debuggen
.Range("B" & von & ":B" & bis).Copy Sheets("Tabelle1").Range("C" & zt1)
markiert.Ansonsten bei mehr als einem Eintrag macht das Makro was es soll. Kann mir jemand bitte helfen das Makro anzupassen?
LG
Jenny
Sub Makro1()
' Makro1 Makro
' Tastenkombination: Strg+i
Dim zt1, von, bis As Long
Dim Grafiken As Shape
zt1 = Sheets("Tabelle1").Range("A1").SpecialCells(xlCellTypeLastCell).Row
von = 1
bis = Sheets("Tabelle2").Range("B" & von).End(xlDown).Row
With Sheets("Tabelle2")
.Range("B" & von & ":B" & bis).Copy Sheets("Tabelle1").Range("C" & zt1)
End With
With Sheets("Tabelle3")
.Range("E" & von & ":E" & bis).Copy
End With
With Sheets("Tabelle1")
.Range("D" & zt1).PasteSpecial (xlValues)
End With
Application.CutCopyMode = False
With Sheets("Tabelle1")
.Range("A" & zt1 & ":B" & zt1).Copy .Range("A" & zt1 + 1 & ":A" & zt1 + bis - von)
End With
Application.CutCopyMode = False
With Sheets("Tabelle1")
.Range("A1:G" & zt1 + 1 + bis - von).Sort key1:=.Range("D1"), Order1:=xlDescending, Header:= _
xlNo
End With
With Sheets("Tabelle2")
.Range("A" & von & ":C" & bis).Clear
End With
With Sheets("Tabelle3")
.Range("A" & von & ":D" & bis).Clear
For Each Grafiken In .Shapes
Grafiken.Delete
Next
End With
End Sub