Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Zusammenfassung von Tabellen





Frage

Hallo Ich habe in Tabelle 1, Tabelle2 etc jeweils zeilenweise Einträge. Nun möchte ich, dass diese automatisch in der Tabelle "Zusammenfassung" zusammengefasst werden. Wie mache ich das am besten, so dass keine Leerzeilen entstehen. Danke für die Hilfe

Antwort 1 von Saarbauer

Hallo,

ist im Prinzip das gleiche Problem, lösung müsste bei dir eventuell angepasst werden.

https://supportnet.de/threads/1180045

Gruß

Helmut

Antwort 2 von Fragenkatalog

Hallo Saarbauer,

hoff du kannst dich noch an mich errinnern. Du hast mir die lösung zu meinem Problem geliefert.
Ich hätte jetzt nur noch eine Frage.

Es sind ca. 190 Tabellen. die heißen Verbund_0201 und gehen bis Verbund_6586 aber dazwischen sind einige verbunde nicht da und da bringt er mir ne Fehlermeldung.

Kann man da irgendwas einbauen, dass es auch die Zahlen überspringt wenn die nicht da sind und er mag auch die 0 vor der zahl nicht. gibts da auch ne Lösung..

Danke

Antwort 3 von nighty

hi all :)

hier noch eine variante der sheet erfassung,wobei das erste sheet der zusammenfassung dient :)

gruss nighty

Sub SheetErfassung()
Dim myWorksheet As Object
Dim myZeilen As Long
For Each myWorksheet In ThisWorkbook.Sheets
If myWorksheet.Index > 1 Then
For myZeilen = 1 To Sheets(myWorksheet.Index).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
Sheets(1).Cells(Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 1) = Sheets(myWorksheet.Index).Range("A" & myZeilen)
Next myZeilen
End If
Next
End Sub

Antwort 4 von Saarbauer

Hallo,

geht, man muss abfragen ob die Datei vorhanden ist. Sollte diese nicht da sein , Datei überspringen. Muss ich mal nachsehen wie die Befehle heissen, komm ich aber frühstens morgen dazu.

Ein anderer weg äwre die Dateien entsprechen umzubenennen, geht super mit Joe

http://lab1.de/Central/Software/Datei-Tools/Joe/

sieh mal da nach. Damit wäre es schneller erledigt

Gruß

Helmut

P.S falls du die orginaldateinamen später noch mal brauchst, mit Kopien arbeiten

Antwort 5 von nighty

hi all :)

hier eine variante ohne namensbedeutung der mappen bei der gesamtmappenerfassung einer directory dessen dateien die endung xls besitzen :)))

gruss nighty

Option Explicit
Sub MappenErfassung()
Dim Mappen As Integer
With Application.FileSearch
.NewSearch
.LookIn = "C:\ExcelMappen"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Mappen)
Workbooks(2).Sheets(1).Range("A1:C10").Copy _
Workbooks(1).Sheets(1).Range("A" & Workbooks(1).Sheets(1). _
UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1 & ":C" & _
Workbooks(1).Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Workbooks(2).Close
Next Mappen
End If
End With
End Sub

Antwort 6 von Fragenkatalog

Hätte dann noch eine Frage..

Wie mache ich es wenn die Namen der Tabellen unterschiedlich sind? Kann ich da eine Liste einspeicher und immer wenn ich die liste ändere, hlot er sich die Daten aus den Tabellen.

Antwort 7 von Fragenkatalog

Hallo nighty,

ich habe jetzt mal deinen lösungsweg anwewandt.

Das einige Problem ist, dass meine Tabellen unterschiedlich lang sind also von a bis v und von 4 bis x.
wie muss dann die formel heißen?
wenn ich nicht nur bis 10 copieren will sonder bis zur letzten zeile?

Danke

Antwort 8 von Saarbauer

Hallo,

so abändern


Option Explicit
Sub MappenErfassung()
Dim Mappen As Integer
With Application.FileSearch
.NewSearch
.LookIn = "C:\ExcelMappen"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Mappen)
Letztezeile = Workbooks(2).Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row )
Workbooks(2).Sheets(1).Range("A1:" & Letztezeile).Copy _
Workbooks(1).Sheets(1).Range("A" & Workbooks(1).Sheets(1). _
UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1 & ":C" & _
Workbooks(1).Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Workbooks(2).Close
Next Mappen
End If
End With
End Sub

und Wert in Zeile

Workbooks(2).Sheets(1).Range("A1:10").Copy _

löschen

Gruß

Helmut

Antwort 9 von Fragenkatalog

danke Helmut.
jetzt ist mir nur aufgefallen, dass das Programm ddas erste Datenblatt copiert. gibt es auch ne möglichkeit immer das gleiche datenblatt Sicherheiten kopiern zu lassen. Falls es vorhanden ist und wenn nicht dann überspringen..

Danke dir

Antwort 10 von Fragenkatalog

Option Explicit
Sub MappenErfassung()
Dim Mappen As Integer
Dim Letztezeile As Integer
With Application.FileSearch
.NewSearch
.LookIn = "Y:\Eigene Dateien\Test"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Mappen)
Letztezeile = Workbooks(2).Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Workbooks(2).Sheets(1).Range("A4:" & Letztezeile).Copy _
Workbooks(1).Sheets(1).Range("A" & Workbooks(1).Sheets(1). _
UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1 & ":C" & _
Workbooks(1).Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Workbooks(2).Close
Next Mappen
End If
End With
End Sub

Was ist da der Fehler. der Bringt mir ein " anwendungs- oder objektdefinierter Fehler"
Wenn man so wie es da steht noch definieren könnte, dass er in das Blatt "sicherheiten" geht und da raus kopiert, außer gleich das erste dann wäre mir sehr geholfen und die Dateine überspringen, die dieses Blatt nicht haben.

Großes Lob an euch bis jetzt.
Danke

Antwort 11 von Saarbauer

Hallo,

nicht vergessen, aber heute keine Lust mehr. Bin gerade erst nach Hause gekommen

Gruß

Helmut

Antwort 12 von Saarbauer

Hallo,

gehe mal in den "Visalbasiceditor" Klicke in das programm und gehe mit "F8" es schrittweise durch. In welcher Zeile kommt die Fehlermeldung?

In allen Zeilen mit
Zitat:
Workbooks(2).Sheets( 1)

Workbooks(2).Sheets("Sicherheiten")
ist anstelle der 1 das Wort "Sicherheiten" einzuführen

Achtung funktioniert nur wenn "Sicherheiten" immer gleich geschrieben ist

Gruß

Helmut

Antwort 13 von nighty

hi ihr :))

vielleicht so :)

gruss nighty

Option Explicit
Sub MappenErfassung()
On Error GoTo fehler
Dim Mappen As Integer
Dim Letztezeile As Integer
With Application.FileSearch
.NewSearch
.LookIn = "Y:\Eigene Dateien\Test"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Mappen)
Letztezeile = Workbooks(2).Sheets("Sicherheiten").UsedRange.SpecialCells(xlCellTypeLastCell).Row
Letztespalte = Workbooks(2).Sheets("Sicherheiten").UsedRange.SpecialCells(xlCellTypeLastCell).Column
If Err <> 9 Then
Workbooks(2).Sheets("Sicherheiten").Range("A4:" & Chr$(65 + Letztespalte) & Letztezeile).Copy _
Workbooks(1).Sheets(1).Range("A" & Workbooks(1).Sheets(1). _
UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1 & ":C" & _
Workbooks(1).Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End If
Workbooks(2).Close
Next Mappen
End If
End With
End
fehler:
If Err = 9 Then Resume Next
End Sub

Antwort 14 von Fragenkatalog

Danke an euch alle.
Werde eure Vorschläge mal ausprobieren.

Wünsche euch ein schönes Wochenende.