Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

mehrere Tabellenblätter zusammenführen


Betrifft: mehrere Tabellenblätter zusammenführen von: Sebastian
Geschrieben am: 16.10.2017 19:13:46

Hallo,

bin gerade an einer kleine Datenbank wo ich Inhalte aus mehreren Tabellenblättern in ein Tabellenblatt zusammen kopieren möchte.

Hab schon einieges gefunden aber immer wird ein neues Blatt erstellt was ich nicht möchte.
Hier ein Code den ich gerade benutze. Der ist schon sehr gut nur das er so aussehen müsste das kein neues Blatt erstellt wird und nur die ersten 5 Spalten kopiert werden. Es dürfen auch die Formate nicht übernommen werden.

_____________



Sub Konsolidieren1() 
 'Code für ein allgemeines Modul 
 'Konsolidierung ohne Überschriften ( Zeile 1 ) 
 'In Spalte A wird der Name der Herkunfttabelle gelistet 
 'Ein Tabellenblatt mit dem Namen "Konsolidierung" wird ganz links erstellt. 
 Dim Wks As Worksheet 
 Dim Bereich As Range 
 Dim strLC As String 
 Dim i As Integer 
 Dim lngA As Long 
 Dim lngE As Long 

 Set Wks = Worksheets.Add 
 Wks.Name = "Konsolidierung" 
 Wks.Move Before:=Sheets(1) 

 For i = 2 To Worksheets.Count 
  With Worksheets(i).UsedRange 
   strLC = .Cells(.Rows.Count, .Columns.Count).Address 
   Set Bereich = .Range("A2:" & strLC) 
   lngA = Wks.Cells(Rows.Count, 1).End(xlUp).Row + 1 
   lngE = Bereich.Rows.Count 
   Wks.Range("A" & lngA & ":A" & (lngE + lngA - 1)) = Worksheets(i).Name 
   Bereich.Copy 
   Wks.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial , Paste:=xlValues 
  End With 
 Next i 
 End 


Sub 

Vielleicht kann mir ja einer helfen.
Danke 
Sebastian 


  

Betrifft: Nachfrage von: Werner
Geschrieben am: 16.10.2017 19:50:18

Hallo Sebastian,

da gibt es noch einige Fragen:

-in welches Blatt soll kopiert werden?
-wohin in diesem Blatt soll kopiert werden?
-sollen dort bereits vorhandenen Daten überschrieben werden?
-oder soll beim erneuten Ausführen ans Ende der vorhandenen Daten kopiert werden?
-sind die 5 Spalten der Quellblätter immer gleich weit befüllt (gleiche Zeile)?
-welche 5 Spalten sollen kopiert werden, A bis E?

Gruß Werner


  

Betrifft: AW: Nachfrage von: Sebastian
Geschrieben am: 16.10.2017 20:09:38

Hallo,

die Mappe hat den Namen "Konsolidierung" und steht an erster stelle
ab Zelle A5 soll reinkopiert werden
die bereits vorhandenen Daten sollen Überschrieben werden aber nur in den spalten A bis E
ja die 5 Spalten der Quellblätter sind unterschiedlich weit befüllt.
ja es sollen immer die Spalten A-E kopiert werden.
klasse wäre es wenn wie in diesem VBA dan in der Mappe "Konsolidierung" eine Spalte vor das Ergebnis eingefügt wird mit dem jeweiliegen Namen der Mape aus dem das Ergebnis ist.

"Tabelle3 Artikeln. 15015033 Wurm 12,99 18-22-00"


Gruß
Sebastian


  

Betrifft: AW: mehrere Tabellenblätter zusammenführen von: Sebastian
Geschrieben am: 16.10.2017 20:37:47

Hallo noch mal
Hab mit diesem Code begonen.Der funktioniert zwar aber mir immer das Format mitschleppt was überhaupt nicht geht da teilweise dann die Formeln natürlich nicht mehr passen. Und der Name des Blatts wäre schon klasse.
_______________________________________________

Sub neut()
For i = 1 To Sheets.Count + 1
    If i > Sheets.Count Then
       Set NewSheet = Worksheets.Add
       NewSheet.Name = "Auswertung"
    End If
    If Sheets(i).Name = "Auswertung" Then
       MsgBox "Tabellenblatt Auswertung ist bereits vorhanden!"
       Exit For
    End If
Next i
Set ws1 = Worksheets("Auswertung")
anz1 = ws1.Cells(65356, 1).End(xlUp).Row
ws1.Range("a2:d" & anz1).ClearContents
For i = 3 To Sheets.Count
    If Sheets(i).Name <> "Auswertung" Then
       anz1 = ws1.Cells(65356, 1).End(xlUp).Row
       Set ws2 = Worksheets(Sheets(i).Name)
       anz2 = ws2.Cells(65356, 1).End(xlUp).Row
       ws2.Range("a2:d" & anz2).Copy Destination:=ws1.Range("a" & anz1 + 1)
       
    End If
Next i
End Sub

________________________________

Gruss
Sebastian


  

Betrifft: Beispielmappe von: Werner
Geschrieben am: 16.10.2017 23:44:41

Hallo Sebastian,

vorhin hast du geschrieben, dass du in der Zieltabelle vor der Spalte A noch eine Spalte einfügen willst, damit dort eingefügt werden kann, aus welchem Blatt die kopierten Daten kommen.

Stellt sich die Frage, weshalb kopierst du denn nicht gleich nach Spalte B, dann ist die Spalte A frei?

Zudem hast du am Anfang davon gesprochen, dass jeweils die ersten 5 Spalten kopiert werden sollen. Jetzt präsentierst du einen Code, der aber nur 4 Spalten kopiert, von A-D.

Zudem hast du gesagt, dass die 5 Spalten die kopiert werden sollen unterschiedlich befüllt sind. In deinem Code ermittelst du die letzte belegte Zelle in Spalte A. Das kann aber nur dann funktionieren, wenn auch sicher die Spalte A die Spalte ist, die gesichert am weitesten mit Daten befüllt ist.

Es ist vielleicht besser, wenn du mal eine kleine Beispielmappe machst. Einmal dein Zielblatt, in dem du dann aufzeigst, wie dein Ergebnis aussehen soll und zumindest ein Quellblatt mit ein paar Spieldaten. Die Datei dann bitte hier hochladen.

Gruß Werner


  

Betrifft: AW: Beispielmappe von: Sebastian
Geschrieben am: 17.10.2017 09:36:49

Hallo Werner,

hier der Link zu der Beispielmappe:
https://www.herber.de/bbs/user/117013.xls

In den Quellblättern ist die Spalte A die, die am weitesten immer befüllt wird aber je nach Blatt in unterschiedlicher Länge. Da hier die Menge der Datensätze unterschiedlich ist.
Alles weiter habe ich in den Blättern beschrieben.
Sorry das ich dich mit dem zweiten Code noch mehr verwiert habe.
Hoffe mit der Beispielmappe klappts besser.

Gruss
Sebastian


  

Betrifft: AW: Beispielmappe von: Werner
Geschrieben am: 17.10.2017 11:35:39

Hallo Sebastian,

in deiner Testdatei habe ich im Blatt "Auswertung" vorne eine Spalte "Tabellenblatt" eingefügt für die Namen der Blätter, aus denen die Daten kommen. Die eigentlichen Daten werden dann ab Zeile 6 in Spalte B eingefügt.

Das Makro ist im Modul1, Schaltfläche ist schon damit verknüpft.

Test mal.

https://www.herber.de/bbs/user/117020.xlsm

Gruß Werner


  

Betrifft: AW: Beispielmappe von: Sebastian
Geschrieben am: 17.10.2017 20:42:43

Hallo Werner,
Vielen Dank für den Code funktioniert schon prima.
Hab auch schon angepasst das er erst ab Zeile 6 die Werte löscht so komm ich mit den Überschriften weiter runter.

Mir ist aufgefallen das wenn ich eine weiter Mappe einfüge und diese anders als RS... beshrifte die Werte nicht übernommen werden.
Hast du dafür eine Lösung das egal was als name eingepflegt ist dies übernommen wird.

lg
Sebastian


  

Betrifft: AW: Beispielmappe von: Werner
Geschrieben am: 18.10.2017 10:24:59

Hallo Sebastian,

ja, das ist so. Ich frage im Code ja die ersten zwei Zeichen des jeweiligen Tabellenblattes ab. Nur wenn diese passen, werden die Daten geholt.
Wenn auch anders benannte Blätter mit einbezogen werden sollen, dann müsste man das über den Ausschluß der Blätter machen, die ausgenommen werden sollen.

Welche Blätter sollen nicht bearbeitet werden (Namen)?

Stell den Code bitte nochmal online. Ich habe momentan keinen Zugriff auf meinen heimischen Rechner und Dateien mit Makros kann ich im Moment auch nicht herunter laden.

Gruß Werner


  

Betrifft: AW: Beispielmappe von: Sebastian
Geschrieben am: 19.10.2017 08:38:01

Hallo Werner,
hab es mir noch mal angeschaut und beschlossen vor die Nammen einfach ein zusätzliches Kürzel eingefügt"HFB" im Code schon zu sehen.

Wenn du magst kannst aber gern den Code auch umschreiben. Die Tabellenblätter die nicht mit einbezogen werden sollen haben folgende Namen:
Auswertung
Daten 1
Daten 2
bis
Daten 5


Und hier der Code:

___________________________________________________________________________
Option Explicit

Public Sub Daten_sammeln()
Dim loLetzteQ As Long, loLetzteZ As Long, loBeginn As Long
Dim wsQ As Worksheet, wsZ As Worksheet

Set wsZ = Worksheets("Auswertung")

With wsZ
    loLetzteZ = .Cells(.Rows.Count, 2).End(xlUp).Row
    If loLetzteZ >= 6 Then
        .Range(.Cells(6, 1), .Cells(loLetzteZ, 4)).ClearContents
    End If
End With

Application.ScreenUpdating = False

For Each wsQ In ThisWorkbook.Worksheets
    If Left(wsQ.Name, 3) = "HFB" Then
        With wsQ
            loLetzteQ = .Cells(.Rows.Count, 1).End(xlUp).Row
            loLetzteZ = wsZ.Cells(wsZ.Rows.Count, 2).End(xlUp).Row + 1
            If loLetzteZ <= 6 Then loLetzteZ = 6
            .Range(.Cells(2, 1), .Cells(loLetzteQ, 4)).Copy
            wsZ.Cells(loLetzteZ, 2).PasteSpecial xlValues
            Application.CutCopyMode = False
            loLetzteZ = wsZ.Cells(wsZ.Rows.Count, 2).End(xlUp).Row
            loBeginn = wsZ.Cells(wsZ.Rows.Count, 1).End(xlUp).Row + 1
            If loBeginn <= 6 Then loBeginn = 6
            wsZ.Range(wsZ.Cells(loBeginn, 1), wsZ.Cells(loLetzteZ, 1)) = wsQ.Name
        End With
    End If
Next wsQ

Set wsZ = Nothing
Application.ScreenUpdating = True
End Sub
__________________________________________________________________________
lg
Sebastian


  

Betrifft: AW: Beispielmappe von: Werner
Geschrieben am: 20.10.2017 00:24:59

Hallo Sebastian,

hier der geänderte Code:

Public Sub Daten_sammeln()
Dim loLetzteQ As Long, loLetzteZ As Long, loBeginn As Long
Dim wsQ As Worksheet, wsZ As Worksheet

Set wsZ = Worksheets("Auswertung")

With wsZ
    loLetzteZ = .Cells(.Rows.Count, 2).End(xlUp).Row
    If loLetzteZ >= 6 Then
        .Range(.Cells(6, 1), .Cells(loLetzteZ, 4)).ClearContents
    End If
End With

Application.ScreenUpdating = False

For Each wsQ In ThisWorkbook.Worksheets
    If Left(wsQ.Name, 5) = "Daten" Or wsQ.Name = "Auswertung" Then
    Else
        With wsQ
            MsgBox .Name
            loLetzteQ = .Cells(.Rows.Count, 1).End(xlUp).Row
            loLetzteZ = wsZ.Cells(wsZ.Rows.Count, 2).End(xlUp).Row + 1
            If loLetzteZ <= 6 Then loLetzteZ = 6
            .Range(.Cells(2, 1), .Cells(loLetzteQ, 4)).Copy
            wsZ.Cells(loLetzteZ, 2).PasteSpecial xlValues
            Application.CutCopyMode = False
            loLetzteZ = wsZ.Cells(wsZ.Rows.Count, 2).End(xlUp).Row
            loBeginn = wsZ.Cells(wsZ.Rows.Count, 1).End(xlUp).Row + 1
            If loBeginn <= 6 Then loBeginn = 6
            wsZ.Range(wsZ.Cells(loBeginn, 1), wsZ.Cells(loLetzteZ, 1)) = wsQ.Name
        End With
        End If
Next wsQ

Set wsZ = Nothing
Application.ScreenUpdating = True
End Sub
Gruß Werner


  

Betrifft: AW: Beispielmappe von: Sebastian
Geschrieben am: 20.10.2017 09:40:02

Hallo Werner,
danke dafür.
Ich nerv zwar ungern aber ich hab festgestellt das in die einzelnen Mappen die Daten in andere Zeilen uns Spalten importiert werden müssen.
z.B.
HFB RS01
ab Spalte 2 und Zeile 6

Habs selbst versucht die Werte in dem Code zu ändern aber komme nicht weiter.
Teilweise nimmt er die Werte leider ab der Falschen Zeile und nicht alle.

Anbei noch mal die Datei.

https://www.herber.de/bbs/user/117115.xlsm

Könntest du bitte die Formel darauf noch mal anpassen.
Dann sollte es soweit gut sein.

Dafür vorab schon mal Danke.
Sebastian


  

Betrifft: AW: Beispielmappe von: Werner
Geschrieben am: 20.10.2017 17:51:13

Hallo Sebastian,

kann damit jetzt leider nicht so viel anfangen. Was meinst du damit?
das in die einzelnen Mappen die Daten in andere Zeilen uns Spalten importiert werden müssen.

Nicht mehr die Daten aus den Quellblättern von A1 bis D letzteZeile holen?

Mit der hochgeladenen Datei kann ich im Moment nichts anfangen. Kann hier keine .xlsm herunter laden.

Beschreib doch mal genau, was du meinst und lade die Datei ohne Makros, als normale .xls hoch.

Grup Werner


  

Betrifft: AW: Beispielmappe von: Nagel
Geschrieben am: 20.10.2017 20:06:39

Hallo Werner anbei die Datei in xls.

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

Nun was ich meine ist das die zu importierenden Werte für die Mappe Auswertung.
Also z.B. in der Mappe "HFB RS01" nun nicht mehr in der spalte A- D und ab Zeile 2 wie bisher sondern jetzt in der Spalte B-E und ab der 6 Zeile sind.
Hoffe damit kannst du was anfangen.
lg
Sebastian


  

Betrifft: AW: Beispielmappe von: Werner
Geschrieben am: 20.10.2017 20:17:19

Hallo Sebastian,

dann so:

Public Sub Daten_sammeln()
Dim loLetzteQ As Long, loLetzteZ As Long, loBeginn As Long
Dim wsQ As Worksheet, wsZ As Worksheet
   
Set wsZ = Worksheets("Auswertung")
   
With wsZ
    loLetzteZ = .Cells(.Rows.Count, 2).End(xlUp).Row
    If loLetzteZ >= 6 Then
        .Range(.Cells(6, 1), .Cells(loLetzteZ, 4)).ClearContents
    End If
End With
   
Application.ScreenUpdating = False
   
For Each wsQ In ThisWorkbook.Worksheets
    If Left(wsQ.Name, 5) = "Daten" Or wsQ.Name = "Auswertung" Then
    Else
        With wsQ
            loLetzteQ = .Cells(.Rows.Count, 2).End(xlUp).Row
            loLetzteZ = wsZ.Cells(wsZ.Rows.Count, 2).End(xlUp).Row + 1
            If loLetzteZ <= 6 Then loLetzteZ = 6
            .Range(.Cells(6, 2), .Cells(loLetzteQ, 5)).Copy
            wsZ.Cells(loLetzteZ, 2).PasteSpecial xlValues
            Application.CutCopyMode = False
            loLetzteZ = wsZ.Cells(wsZ.Rows.Count, 2).End(xlUp).Row
            loBeginn = wsZ.Cells(wsZ.Rows.Count, 1).End(xlUp).Row + 1
            If loBeginn <= 6 Then loBeginn = 6
            wsZ.Range(wsZ.Cells(loBeginn, 1), wsZ.Cells(loLetzteZ, 1)) = wsQ.Name
        End With
    End If
Next wsQ
   
Set wsZ = Nothing
Application.ScreenUpdating = True
End Sub
Gruß Werner


  

Betrifft: AW: Beispielmappe von: Nagel
Geschrieben am: 20.10.2017 20:34:28

Hallo Werner,

FUNKT wie eine 1.

Vielen Dank dafür und die Geduld

Grüsse
Sebastian


  

Betrifft: Gerne u. Danke für die Rückmeldung. o.w.T. von: Werner
Geschrieben am: 20.10.2017 20:40:40




Beiträge aus den Excel-Beispielen zum Thema "mehrere Tabellenblätter zusammenführen"