Forums Neueste Beiträge
 

VBA Datensätze zusammenführen

21/01/2010 - 15:43 von Beck, Alwin | Report spam
Hallo,

habe eine Exceltabelle mit mehreren Tabellenblàttern.
Alle Tabellenblàtter sind identisch aufgebaut.
Nun möchte ich die Datensàtze aller Tabellenblàtter in ein
Tabellenblatt zusammenführen,
jedoch darf die Überschrift (welche in jedem Tabellenblatt vorhanden
ist) ja nur einmal
vorkommen ?

Wie kann ich das machen, dass alle Tabellenblàtter durchlaufen werden,
Inhalt in das Tabellenblatt
"Gesamt" kopiert wird - jedoch nur mit einer Überschriftszeile ?

Danke
Gruß
Albe
 

Lesen sie die antworten

#1 Andreas Killer
21/01/2010 - 15:53 | Warnen spam
Beck, Alwin schrieb:

Wie kann ich das machen, dass alle Tabellenblàtter durchlaufen werden,
Inhalt in das Tabellenblatt
"Gesamt" kopiert wird - jedoch nur mit einer Überschriftszeile ?



Sub ZusammenKopieren()
'Kopiert alle Blàtter in das aktuelle Blatt
Dim WS As Worksheet, Dest As Range
'Bei Überschriften auf 2 àndern
Const ErsteZeile = 2
'Durchlaufe alle Blàtter
For Each WS In Worksheets
'Ist es dieses Blatt?
If WS.Name <> ActiveSheet.Name Then
'Letzte Zelle in diesem Blatt bestimmen
Set Dest = SheetLastCell
'Nàchste Zeile, Spalte A
Set Dest = Cells(Dest.Row + 1, 1)
'Daten kopieren
WS.Range(WS.Cells(ErsteZeile, 1), SheetLastCell(WS)) _
.Copy Dest
End If
Next
End Sub

Private Function SheetLastCell(Optional S As Worksheet) As Range
'Liefert die letzte verwendete Zelle der Tabelle
Dim R As Range, C As Range
If S Is Nothing Then Set S = ActiveSheet
Set R = S.Cells.SpecialCells(xlCellTypeLastCell)
If IsEmpty(R) And Not R.Address = Cells(1, 1).Address Then
Set C = S.Cells.Find("*", After:=R, SearchOrder:= _
xlByColumns, SearchDirection:=xlPrevious)
If C Is Nothing Then
Set SheetLastCell = S.Cells(1, 1)
Else
Set R = S.Cells.Find("*", After:=R, SearchOrder:= _
xlByRows, SearchDirection:=xlPrevious)
Set SheetLastCell = S.Cells(R.Row, C.Column)
End If
Else
Set SheetLastCell = R
End If
End Function

Ähnliche fragen