Microsoft Excel

Herbers Excel/VBA-Archiv

Bereiche in separates sheet

Betrifft: Bereiche in separates sheet von: Eddi
Geschrieben am: 28.07.2008 17:40:46

Hallo zusammen,

hoffe mir kann jemand helfen.
Ich habe auf 24 sheets die gleiche tabellenstruktur, allerdings ist die Tabelle eines jeden sheets unterschiedlich gefüllt (unterschiedlich häufige Anfragen je Land). In einem "Total" sheet hätte ich gern alle Einträge eines jeden sheets untereinander aufgelistet.
Wie stell ich das am dümmsten an?
Ich bräuchte sowas wie: Ist die Zelle Anfragedatum<>leer, dann nimm die komplette Zeile und kopiere Sie in das "Total"-sheet, sonst mach das ganze im nächsten sheet, beim nächsten Land.
Oder mit Bereiche oder so?

Gruß

Eddi

  

Betrifft: AW: Bereiche in separates sheet von: Tino
Geschrieben am: 29.07.2008 01:26:03

Hallo,
test mal diesen Code.
Kopiert alle Tabellen nach Total und Sortiert diese nach nicht leeren Zellen,
dafür wird die letzte Spalte im Tabellenblatt benutzt, diese wird zum Schluss wieder gelöscht.

'Kopiert alle Tabellen nach Total
Sub KopiereTabellen()
Dim objTab As Worksheet
Application.ScreenUpdating = False
Sheets("Total").Cells.Clear
With Sheets("Total")

For Each objTab In ThisWorkbook.Worksheets

 If objTab.Name <> "Total" Then
 
   objTab.UsedRange.Copy
   .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row + 1, 1) _
   .End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 End If

Next objTab

.Select
End With
Call SortiereNachLeer
Application.ScreenUpdating = True
Range("A1").Select
End Sub
'Sortiert um die Leeren Zeilen zu entfernen
Sub SortiereNachLeer()
Dim Bereich As Range
With Sheets("Total")
Set Bereich = .Range("A1", "A" & .Cells.SpecialCells _
(xlCellTypeLastCell).Row).Offset(0, Columns.Count - 1)
Bereich.FormulaR1C1 = "=IF(COUNTA(RC1:RC[-1])>0,ROW(),"""")"
Bereich.Value = Bereich.Value
        Rows("1:" & .Cells.SpecialCells(xlCellTypeLastCell).Row).Sort _
        Key1:=.Cells(1, .Columns.Count), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Bereich.ClearContents
End With
End Sub



Gruß Tino

www.VBA-Excel.de




  

Betrifft: AW: Bereiche in separates sheet von: Eddi
Geschrieben am: 29.07.2008 08:41:06

Hallo Tino,



hat leider nicht zum gewünschten Ergebnis geführt, darum habe ich nochmal eine Beispieldatei kreiert, um das Problem noch einmal zu verdeutlichen.

Ziel sollte es sein, im sheet Total eine Überschrift zu haben und die kompletten Zeilen, die ein "Date of request" haben sollten darunter aufgelistet sein. Meinst du das geht? https://www.herber.de/bbs/user/54186.xls






Viele Grüße Eddi


  

Betrifft: AW: Bereiche in separates sheet von: Tino
Geschrieben am: 29.07.2008 11:46:13

Hallo,
ist es so besser?

https://www.herber.de/bbs/user/54193.xls

Gruß Tino


  

Betrifft: AW: Bereiche in separates sheet von: Eddi
Geschrieben am: 29.07.2008 13:48:51

A Traum!!!
Und wie funktionierts?

Gruß

Henning


  

Betrifft: AW: Bereiche in separates sheet von: Tino
Geschrieben am: 29.07.2008 14:10:58

Hallo,
bin zwar kein VBA Lehrer aber ich versuche es mal zu erklären.

In der For Each Schleife werden alle Tabellen durchgegangen, Tabelle Total wird übersprungen.
Aus der ersten Tabelle wird die Überschrift gezogen.
In der Do While Schleife werden jetzt alle Zellen ab C3 bis zum eintreten der ersten Zelle mit Text durchlaufen (ist die Zeile mit Total).
Beim Durchlauf wird auch geprüft, ob der Inhalt der Zelle ein Datum oder eine Zahl ist (leere Zellen sind auch Zahlen), ist die Zelle nicht leer wird die Zeile komplett nach Total in die nächste freie Zeile kopiert.

Alles klar?


Gruß Tino

www.VBA-Excel.de




 

Beiträge aus den Excel-Beispielen zum Thema "Bereiche in separates sheet"