Hallo,
nachdem ich hier schon sehr viel Hilfe erhalten habe, möchte ich noch einmal versuchen ein weiteres Problem zu schildern:
Ich habe es geschafft ein Makro zu erstellen, dass aus einer Tabelle 1 zwei Spalten kopiert und diese an zwei verschiedenen Stellen in einer neuen Tabelle 2 einfügt. Das klappt auch.
Nun das Problem:
In der Tabelle 1 möchte ich im Anschluss des kopierens Bereiche verschieben. Dies sollte mit kopieren und einfügen funktionieren.
Dann sollte in Tabelle 1 noch in zwei Spalten in bestimmten Zellen der Wert „0“ eingetragen werden.
Das verschieben des Bereichs durch kopieren und einfügen sowie das Schreiben des Wer-tes „0“ in bestimmte Zellen funktioniert mit den eingetragenen Code nicht. Eine Fehler-meldung erscheint aber auch nicht.
Wahrscheinlich könnte man das auch "eleganter" erstellen, was mir aber leider nicht gelingt...
Kann mir jemand erklären was ich falsch mache?
Den Code habe ich hier eingefügt:
Sub kopieren()
'Teil 1 rechte Spalte kopieren und ganz rechts in Tabelle 2 in erster freier Spalte einfügen
Sheets("Tabelle1").Activate
Sheets("Tabelle1").Range("L1:L89").Copy
Sheets("Tabelle2").Activate
Cells(1, Range("IV1").End(xlToLeft).Column + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Teil 2 linke Spalte kopieren und vor dem Kriterium "1" als neue Spalte in Tabelle 2 einfügen
For Each c In Sheets("Tabelle2").Range("A1:IV1")
If c = "1" Then
On Error GoTo fehler
c.Offset(0, 0).EntireColumn.Insert 'Spalte einfügen
Sheets("Tabelle1").Range("D1:D109").Copy
c.Offset(1, -1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False 'Auswahl aufheben
Sheets("Tabelle1").Select
Exit Sub
End If
Next c
fehler:
MsgBox ("Der Bereich kann nicht eingefügt werden")
'Teil 3: verschieben der Bereiche von Tabelle 1 durch kopieren und einfügen
Sheets("Tabelle1").Range("E4:H109").Copy
Sheets("Tabelle1").Range("D4:G109").ActiveSheet.Paste
'Teil 4: Werte in bestimmten Zellen auf Null setzen
Sheets("Tabelle1").Activate
Union(Range("Tabelle1!H5:H6"), Range("Tabelle1!H10:H11")).Value = "0.00"
End Sub