Datenblätter zusammen kopieren und aktualisieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Datenblätter zusammen kopieren und aktualisieren
von: Al ex
Geschrieben am: 13.11.2015 09:09:13

Hallo zusammen,
ich brauche unbedingt mal eure Hilfe zu folgender Aufgabenstellung.
Meine Excelkenntnisse sind eher mau.
Ich nutze Excel 2010.
Ich habe eine Excel Datei, in der 100 Tabellenblätter enthalten sind.
Ein Tabellenblatt ist dabei immer gleich von den Spaltenüberschriften aufgebaut.
Nun möchte ich ohne copy und paste folgendes machen:
1. Zusammenfassen aller Datenblätter in ein Datenblatt, also in einer Tabelle. Dabei soll nur einmal die Spaltenüberschrift erscheinen, unter die dann die Inhalte aus allen Datenblättern eingefügt werden.
2. Die einzelnen Datenblätter werden zum Teil aktualisiert.
Ich brauch eine 2. Funktion, die genau das gleiche macht, aber nur die Aktualisierungen kopiert oder mir wenigstens anzeigt, was zu den bestehenden Daten hinzu gekommen ist.
Ist das möglich? Ich bin grad echt verzweifelt.
Vielen Dank!

Bild

Betrifft: AW: Datenblätter zusammen kopieren und aktualisieren
von: Tino
Geschrieben am: 13.11.2015 09:37:39
Hallo,
wenn Du ein Beispiel hast könnte man mit VBA versuchen etwas bauen.
Gibt es eine Spalte an der man die Daten eindeutig zuordnen kann?
Gruß Tino

Bild

Betrifft: AW: Datenblätter zusammen kopieren und aktualisieren
von: Al ex
Geschrieben am: 13.11.2015 10:13:33
Hallo Tino,
vielen Dank für deine schnelle Antwort.
Ich habe mal ein Beispiel hier hochgeladen.
https://www.herber.de/bbs/user/101485.xlsx

Bild

Betrifft: und die zweite Frage
von: Tino
Geschrieben am: 13.11.2015 10:21:49
Hallo,
Gibt es eine Spalte an der man die Daten eindeutig zuordnen kann?
Also wenn dieser Wert/Text in der Master schon vorhanden ist dann nicht importieren.
Oder müssen immer alle 7 Spalten verglichen werden?
Gruß Tino

Bild

Betrifft: AW: und die zweite Frage
von: Al ex
Geschrieben am: 13.11.2015 10:39:41
Es gibt leider keine eindeutige ID.
Die Lösung müsste also wohl alles vergleichen :/

Bild

Betrifft: versuchen wir es mal so ...
von: Tino
Geschrieben am: 13.11.2015 11:50:21
Hallo,
ok. versuch mal so.
Neue Daten sollten rot gefärbt werden!
https://www.herber.de/bbs/user/101490.zip
Gruß Tino

Bild

Betrifft: AW: versuchen wir es mal so ...
von: Al ex
Geschrieben am: 13.11.2015 12:08:01
Hallo Tino,
das gefällt mir schonmal sehr gut! Vielen Dank dafür.
Nun ist es so, dass die Originaldatei mehr als 7 Spalten hat.
Kannst du mir kurz schildern, wo ich diese Abfrage erweitern kann?
Scannt das Macro alle verfügbaren Datenblätter, oder muss ich den Wert auch numerisch im Macro hinterlegen?
Ich bin begeistert :D
Grüße
Alex

Bild

Betrifft: AW: versuchen wir es mal so ...
von: Al ex
Geschrieben am: 13.11.2015 12:16:03
Moin,
ist es möglich bei der Aktualisierung, die veränderten Datensätze durch die Aktualisierung zu ersetzten? Momentan fügt er einen aktualisierten Datensatz als neuen Datensatz ein. Der veraltete verbleibt leider in der Liste.
Grüße
Alex

Bild

Betrifft: AW: versuchen wir es mal so ...
von: Tino
Geschrieben am: 13.11.2015 13:17:42
Hallo,
versuch mal so.
In den Zeilen kannst die die Anzahl Spalten und die Farbe festlegen.

Const AnzahlSpalten& = 7 'Anzahl der Spalten
FarbeNeu = RGB(255, 0, 0) 'Farbe für neue Daten
https://www.herber.de/bbs/user/101496.xlsm
Gruß Tino

Bild

Betrifft: AW: versuchen wir es mal so ...
von: Al ex
Geschrieben am: 13.11.2015 15:28:20
Dankeschön!
Die Anzeige der Aktualisierung funktioniert leider noch nicht ganz.
Die ganze zusammengefasste Tabelle wird bei der Aktualisierung eines Datensatzes rot gefärbt.
Wenn du das noch weg bekommst, bist du der Held meines Wochenendes!
Nochmal Danke!
Viele Grüße
Alex

Bild

Betrifft: AW: versuchen wir es mal so ...
von: Tino
Geschrieben am: 13.11.2015 15:53:03
Hallo,
dann sind wir bis auf die Spalten wieder beim alten Code.
Weil wenn der Datensatz gleich ist mit dem bereits vorhandenen brauchen wir
diesen auch nicht zu aktualisieren.
Ersetzen den gesamten Code im Modul1 durch diesen.

Option Explicit

Sub Start()
Dim sPath$, NextRow&, FarbeNeu&
Dim ExWB As Workbook, ExWS As Worksheet, ExRng As Range
Dim aktRange As Range, booCopyHeader As Boolean, tmpArCol()


Const AnzahlSpalten& = 7 'Anzahl der Spalten 
FarbeNeu = RGB(255, 0, 0) 'Farbe für neue Daten 

sPath = FileAuswahl(ThisWorkbook.Path, Excel_File_XLSX)

If sPath = "" Then Exit Sub
On Error GoTo ErrorHandler:

Call Events_(False)
With ActiveSheet
    Application.Goto .Cells(2, 1), True
    Set aktRange = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, AnzahlSpalten)
    If aktRange.Rows(1).Row = 1 Then
        booCopyHeader = True
        NextRow = 1
    Else
        aktRange.Interior.Color = xlNone
    End If
End With

Set ExWB = Workbooks.Open(sPath, ReadOnly:=True)

For Each ExWS In ExWB.Worksheets
    If booCopyHeader Then
        With ExWS
            .Calculate
            Set ExRng = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, AnzahlSpalten)
            If ExRng.Rows(1).Row > 1 Then  'Daten vorhanden 
                If booCopyHeader And NextRow = 1 Then
                    .Range("A1").Resize(, 7).Copy aktRange.Parent.Cells(1, 1)
                End If
                With aktRange.Parent
                    NextRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    ExRng.Copy .Cells(NextRow, 1)
                End With
            End If
        End With
    Else
        With ExWS
            Set ExRng = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, AnzahlSpalten)
            If ExRng.Rows(1).Row > 1 Then  'Daten vorhanden 
                With aktRange.Parent
                    NextRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    ExRng.Copy .Cells(NextRow, 1)
                    With .Cells(NextRow, 1).Resize(ExRng.Rows.Count, AnzahlSpalten)
                        .Interior.Color = FarbeNeu
                        .Value = .Value
                    End With
                End With
            End If
        End With
    End If
Next ExWS

ExWB.Close False
Set ExWB = Nothing

With ActiveSheet
    Redim tmpArCol(AnzahlSpalten - 1)
    For NextRow = 0 To AnzahlSpalten - 1
        tmpArCol(NextRow) = NextRow + 1
    Next NextRow
    With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, AnzahlSpalten)
        .RemoveDuplicates Columns:=(tmpArCol), Header:=xlYes
    End With
End With

ErrorHandler:
If Not ExWB Is Nothing Then ExWB.Close False: Set ExWB = Nothing
Call Events_(True)
If Err.Number <> 0 Then
    ActiveSheet.Columns(ActiveSheet.Columns.Count).Delete
    MsgBox Err.Description, _
           vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
           "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub



Sub Events_(booSchalter As Boolean)
With Application
    .ScreenUpdating = booSchalter
    .DisplayAlerts = booSchalter
    .EnableEvents = booSchalter
    .Calculation = IIf(booSchalter, xlCalculationAutomatic, xlCalculationManual)
End With
End Sub
Gruß Tino

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Datenblätter zusammen kopieren und aktualisieren"