AW: Tabbelle neu ordnen
25.06.2015 12:21:20
Thomas
Hallo,
bin am verzweifeln und auch ein wenig stolz. Das Macro funktioniert schon ein wenig.
Habe nur noch den Fehler das der Bereich c:e einmal zu viel kopiert wird. Ich weiss auch das es daran liegt das ich beim zweiten kopieren den zu kopierten Bereich zu gross markiere. Aber ich weiss leider nicht wie ich dies verhindere. Wie kann ich sagen füge den ersten Bereich zweimal untereinander ein?
Dann könnte ich den Abschnitt ' das selbe noch mal löschen?
liebe Grüsse Thomas
Sub Zeile_kopieren()
'1. Bereich kopieren
Range(Cells(2, 3), Cells(Cells(65536, 5).End(xlUp).Row, 5)).Copy ' 2 = ab zeile 2, 3 = ab _
spalte 3 - 5 kopieren
'letzte Zeile in Tabelle1 aus Spalte c
lz = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 1 ' erste leere zeile spalte 3
'Tabelle1, Zelle c in entsprechender Zeile markieren
ActiveSheet.Select
Range("c" & lz).Select
'Daten einfügen
ActiveSheet.Paste
'Markierung aufheben (Zelle c.. markieren)
ActiveSheet.Range("c" & lz).Select
'Kopiermodus beenden
Application.CutCopyMode = xlCopy
' das selbe noch mal
'1. Bereich kopieren
Range(Cells(2, 3), Cells(Cells(65536, 5).End(xlUp).Row, 5)).Copy
'letzte Zeile in Tabelle1 aus Spalte c
lz = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 1
'Tabelle1, Zelle c in entsprechender Zeile markieren
ActiveSheet.Select
Range("c" & lz).Select
'Daten einfügen
ActiveSheet.Paste
'Markierung aufheben (Zelle c.. markieren)
ActiveSheet.Range("c" & lz).Select
'Kopiermodus beenden
Application.CutCopyMode = xlCopy
' spalte j -m
'1. Bereich auschneiden
Range(Cells(2, 10), Cells(Cells(65536, 13).End(xlUp).Row, 13)).Cut
'letzte Zeile in Tabelle1 aus Spalte c
lz = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row + 1
'Tabelle1, Zelle c in entsprechender Zeile markieren
ActiveSheet.Select
Range("f" & lz).Select
'Daten einfügen
ActiveSheet.Paste
'Markierung aufheben (Zelle f.. markieren)
ActiveSheet.Range("f" & lz).Select
'Kopiermodus beenden
Application.CutCopyMode = xlCopy
' n bis q
'1. Bereich auschneiden
Range(Cells(2, 14), Cells(Cells(65536, 17).End(xlUp).Row, 17)).Cut
'letzte Zeile in Tabelle1 aus Spalte c
lz = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row + 1
'Tabelle1, Zelle c in entsprechender Zeile markieren
ActiveSheet.Select
Range("f" & lz).Select
'Daten einfügen
ActiveSheet.Paste
'Markierung aufheben (Zelle f.. markieren)
ActiveSheet.Range("f" & lz).Select
'Kopiermodus beenden
Application.CutCopyMode = xlCopy
End Sub