Office-Fragen.de
Arbeitsblätter zu einem zusammenfügen - Druckversion

+- 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