Den gefüllten Bereich eines Tabellenblattes kopieren
Hallo,
ich möchte den Bereich eines Tabellenblattes markieren und kopieren vom ersten Feld (z.B. A3) bis zum letzten gefüllten Feld (z.B. CD118). Ich müsste dazu also die letzte ermittelte Zelle ermitteln.
Und noch eine Frage habe ich. In meinem Tabellenblatt habe ich mehrere verbundene Zellen. Vor dem Umkopieren (mit Transponieren) muss ich ja leider diese verbundenen Zellen trennen und den ursprünglichen Wert in jede der nun getrennten Zellen reinschreiben.
Dies habe ich so gemacht:
Leider läuft das ziemlich lange, da die Tabelle sehr gut befüllt ist. Wie kann ich das optimieren?
Gruß
Torsten
ich möchte den Bereich eines Tabellenblattes markieren und kopieren vom ersten Feld (z.B. A3) bis zum letzten gefüllten Feld (z.B. CD118). Ich müsste dazu also die letzte ermittelte Zelle ermitteln.
Und noch eine Frage habe ich. In meinem Tabellenblatt habe ich mehrere verbundene Zellen. Vor dem Umkopieren (mit Transponieren) muss ich ja leider diese verbundenen Zellen trennen und den ursprünglichen Wert in jede der nun getrennten Zellen reinschreiben.
Dies habe ich so gemacht:
For Each Zelle In ActiveSheet.UsedRange
If Zelle.MergeCells Then
Inhalt_alt = Zelle.Value
ActiveSheet.UsedRange.MergeCells = False
Inhalt_neu = Zelle.Value
Inhalt_alt = Inhalt_neu
Else
If IsEmpty(Zelle.Value) Then Zelle.Value = Inhalt_alt
End If
Next Zelle
Leider läuft das ziemlich lange, da die Tabelle sehr gut befüllt ist. Wie kann ich das optimieren?
Gruß
Torsten
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 171714
Url: https://administrator.de/forum/den-gefuellten-bereich-eines-tabellenblattes-kopieren-171714.html
Ausgedruckt am: 12.04.2025 um 11:04 Uhr
6 Kommentare
Neuester Kommentar
Hallo TorstenB!
Unabhängig davon, dass Du Zeilen und Spalten in der falschen Reihenfolge angibst (und der Variablenname "Zeilenanzahl) eigentlich irreführend ist, da Du ja eine Zeilennummer ermittelst) und auch nur die Spalte A und die Zeile 1 untersucht werden -
würde zumindest die letzte Spalte der gefundenen letzten Zeile ermitteln - eine Frage: Befindet sich Dein Code in einem Modul? Den Fehler reproduzieren kann ich eigentlich nur, wenn ich den Code einem Blatt zuordne und beim Ausführen ein anderes Blatt das "
Und noch eine Frage: Wozu "
Hinsichtlich des Kopierens oben: "
genügen.
Grüße
bastla
Unabhängig davon, dass Du Zeilen und Spalten in der falschen Reihenfolge angibst (und der Variablenname "Zeilenanzahl) eigentlich irreführend ist, da Du ja eine Zeilennummer ermittelst) und auch nur die Spalte A und die Zeile 1 untersucht werden -
Spaltenanzahl = ActiveSheet.Cells(Zeilenanzahl, Columns.Count).End(xlToLeft).Column
ActiveSheet
" ist ...Und noch eine Frage: Wozu "
Select
"?Hinsichtlich des Kopierens oben: "
.Address
" zu verwenden ist natürlich unnötig (auch, wenn es natürlich trotzdem funktionieren müsste) - es sollte zBActiveSheet.UsedRange.Copy Worksheets("Tabelle2").Range("C4")
Grüße
bastla
Hallo TorstenB!
bzw
funktioniert bei mir aus einem Modul heraus ...
Die letzte verwendete Zeile / Spalte solltest Du übrigens mit
ermitteln können - bzw für die Adresse der letzten Zelle:
Grüße
bastla
Dim Zeilenanzahl As Integer
Dim Spaltenanzahl As Integer
Zeilenanzahl = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Spaltenanzahl = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(1, 1), Cells(Zeilenanzahl, Spaltenanzahl)).Select
Dim Zeilenanzahl As Integer
Dim Spaltenanzahl As Integer
Zeilenanzahl = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Spaltenanzahl = ActiveSheet.Cells(Zeilenanzahl, Columns.Count).End(xlToLeft).Column
Range(Cells(1, 1), Cells(Zeilenanzahl, Spaltenanzahl)).Select
Mit dem Select will ich nur den Bereich markieren und danach kommt ein copy...
Anstelle des "Select
" kannst Du auch gleich "Copy
" verwenden ...Die letzte verwendete Zeile / Spalte solltest Du übrigens mit
LetzteZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
LetzteSpalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
LetzteZelle = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Address
bastla