+- Office-Fragen.de (https://office-fragen.de)
+-- Forum: Microsoft Office (https://office-fragen.de/forum-1.html)
+--- Forum: Excel (https://office-fragen.de/forum-2.html)
+--- Thema: Arbeitsblätter zu einem zusammenfügen (/thread-28850.html)
Arbeitsblätter zu einem zusammenfügen - Fyodor - 24.07.2023
Hallo Forum,
nachdem mir hier an Bord kürzlich schonmal sehr schnell und freundlich geholfen wurde, versuche ich es nochmal.
Ich habe eine Excel-Datei, die eigentlich nur eine sehr lange Liste enthält. Das Problem dabei ist, daß diese Tabelle auf 320 Arbeitsblätter [sic!] "druckerseitengerecht" aufgeteilt ist. Ich möchte jetzt mit dieser Tabelle weiterarbeiten, aber eben als eine einzelne lange Tabelle. Leider habe ich nur diese Kopie, und keinen Zugriff auf die ursprünglichen Quelldaten.
Gibt es dazu eine Möglichkeit, ohne 320 mal copy & paste?
Gruß,
Jochen
RE: Arbeitsblätter zu einem zusammenfügen - Fyodor - 24.07.2023
Noch ein Nachtrag:
Alle Blätter sind genau gleich aufgebaut. Selbe Anzahl Zeilen, und die erste Zeile enthält nur die Seitenzahl.
Richtig genial wäre also, wenn ich aus jedem Arbeitsblatt die erste Zeile entweder vorher löschen, oder nicht mit kopieren müßte.
RE: Arbeitsblätter zu einem zusammenfügen - Fyodor - 24.07.2023
Zu meinem zweiten Problem habe ich schon die Lösung selbst gefunden:
Wenn man alle Arbeitsblätter unten in der Reiterleiste markiert, und dann die störende Zeile löscht, wird sie in allen markierten Blättern gelöscht.
RE: Arbeitsblätter zu einem zusammenfügen - ralf_b - 27.07.2023
versuchs mal damit. hier wird davon ausgegangen das mehrere Blätter markiert sind. Die erste Zeile muß nicht vorher gelöscht worden sein.
Den Namen des Zielblattes noch anpassen im Code
Code:
Sub tst()
Dim i&, sh As Worksheet, arr
Dim shnew As Worksheet
Set shnew = Worksheets("Tabelle4") 'name des Zielblattes
i = 1
For Each sh In ThisWorkbook.Windows(1).SelectedSheets
If i = 1 Then
arr = sh.UsedRange.Value
Else
arr = sh.UsedRange.Offset(1).Resize(sh.UsedRange.Rows.Count - 1).Value
End If
i = shnew.UsedRange.SpecialCells(xlCellTypeLastCell).Row
shnew.Cells(i + 1, "A").Resize(UBound(arr), UBound(arr, 2)) = arr
Next
End Sub