Microsoft Excel

Herbers Excel/VBA-Archiv

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

Daten zusammenfügen und vergleichen

Betrifft: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 07.12.2015 10:32:12

Hallo zusammen,

ich würde gerne bei allen Excelsheets.xlsm (ca. 30) die alle im selben Ordner liegen die Mappe „ACTION“ im bestehenden Excelsheet ZUSAMMENFASSUNG.xlsm von Zeile A2 bis F –letzte beschriebene Zelle- mit allen Formaten auslesen und untereinander ab Zelle A2 bis F auflisten.
Alle Mappen „ACTION“ sind gleich aufgebaut.
Sind die Daten übertragen dürfen neue Daten in einem zweiten Lauf nur per neuer Zeile eingeführt werden. Die Daten werden ab Spalte G weiter verarbeitet und dürfen deshalb nicht ersetzt werden.
Habe viel im Forum gesucht aber nichts passendes gefunden.

Kann mir jemand helfen ? Geht das überhaupt ?

Mit freundlichen Grüßen
Manfred

  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 07.12.2015 11:33:56

ungetestet.

Sub Main()
Const strPath As String = "C:\Users\acer\" 'Pfad anpassen Dateien sind
    Dim strDateiname As String
    Dim wkbBook As Workbook
    Dim lngLastRowQ As Long
    Dim lngLastRowZ As Long
    Dim lngLastCol As Long
    Dim intCalc As Integer
    On Error GoTo Fin
    With Application
        .ScreenUpdating = False
        .AskToUpdateLinks = False
        .EnableEvents = False
        intCalc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    'strDateiname = Dir$(ThisWorkbook.Path & "\*.xls")
    strDateiname = Dir$(strPath & "*.xlsm")
    Do While strDateiname <> ""
        If strDateiname <> ThisWorkbook.Name Then
            Set wkbBook = Workbooks.Open(strPath & strDateiname)
        Call Bearbeiten
        
            wkbBook.Close False ' Oder True, wenn gespeichert werden soll
            Set wkbBook = Nothing
        End If
        strDateiname = Dir$()
    Loop
Fin:
    Set wkbBook = Nothing
    With Application
        .ScreenUpdating = True
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = intCalc
        .DisplayAlerts = True
    End With
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Sub Bearbeiten()
  Sheets("ACTION").Select
      Dim Ez1 As Long    'erste Zeile (hast Du vorgegeben)
    Dim Lz1 As Long    'letzte Zeile (wird ermittelt)
    Dim Spalte1 As String
    Dim Spalte2 As String
    Spalte1 = "A"
    Spalte2 = "F"
    Ez1 = 2      'Vorgabe
    Lz1 = ActiveSheet.Cells(Rows.Count, Spalte2).End(xlUp).Row  'ermitellt letzte Zeile
ActiveSheet.Range(Spalte1 & Ez1 & ":F" & Lz1).Copy
  Windows("ZUSAMMENFASSUNG.xlsm").Activate
   Range("F1000000").Activate
  Selection.End(xlUp).Select
    ActiveCell.Offset(-5, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Das kopierste in deine ZUSAMMENFASSUNG.xlsm rein.
Das Makro sollte die 30 Dateien Zusammenfügen in ZUSAMMENFASSUNG.xlsm.
Die 2. Aufgabe habe ich noch nicht ganz verstanden und daher noch nicht berücksichtigt.
Vielleicht kannste das ja nochmal etwas genauer erklären.
Pfad musst du natürlich ganz oben noch anpassen.


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 07.12.2015 12:13:38

Hallo Christoph,

das Macro steigt mit der Meldung "ERROR: 9 Index außerhalb des gültigen Bereichs" aus.

Die erste Datei.xlsm mit dem Blatt ACTION ist aber geöffnet.

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 07.12.2015 12:22:49

Denke der Grund ist das du die falsche Mappe offen hast, bzw. ich das falsch verstanden habe.
Bei meiner Variante muss das Makro in die Tabelle Zusammenfassung.xlsm (von dir erstellt) kopiert werden. Diese Mappe muss dann geöffnet sein. Dann sollte eigentlich alles klappen.


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 07.12.2015 12:56:50

Hallo Christoph,

habs hinbekommen das Makro läuft. Im zweiten Makro hatte ich den falschen xlsm Name.

Kriegst du das hin, daß alte Daten nicht durch neue Daten überschrieben werden ?


Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 07.12.2015 12:59:59

Wäre nett wenn du das mal genauer erklärst.
Im Moment wird ja nichts überschrieben.
Es werden ja einfach nur alle Daten untereinander eingefügt.


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 07.12.2015 14:07:05

Hallo Christoph,

die Daten sollten jetzt zeilenweise von A2-F2 im ACTION mit der Zusammenfassung.xlsm bis zur letzten Zeile verglichen werden ob diese schon übernommen worden sind. Wenn ja soll nichts passieren. Wenn die Daten noch nicht da sind sollen diese direkt in der Zusammenfassung.xlsm per neuer Zeile eingefügt werden. Dann kommt die nächste zeile.

Geht das ?

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: UweD
Geschrieben am: 07.12.2015 14:24:39

Hallo nochmal

- sind die Datensätze denn eindeutig erkennbar?
- alternativ: ist eine Kennzeichnung in der Ursprungsdatei der Zeile möglich, wenn diese bereits kopiert wurde?

- lade doch mal eine Musterdatei hoch.

- - -

klappt mein Makro jetzt oder nicht?

Gruß UweD


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 07.12.2015 14:59:51

Hallo Uwe,

anbei mal eine Musterdatei. Das Blatt ACTION ist auch mit drinn das musst du noch ausleiten.

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


Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: UweD
Geschrieben am: 07.12.2015 16:55:40

Hi

ok. Habe gesehen, warum nicht in der zweiten Zeile eingefügt wird.

> Du hast "Bedingte Formatierung" in dem Zielblatt bis irgendwo in Zeile ~4000 eingetragen.
> Also liegt die erste freie Zelle da hinter.

so ginge das aber

            LR0 = TB0.Cells(Rows.Count, 1).End(xlUp).Row + 1



- Um es einigermaßen schnell zu machen und nicht alle Zeilen einzeln zu vergleichen, könnte man z.B. in Spalte H in den ACTION- Dateien ein "übernommen" eintragen

- Beim Kopieren dann nur die Zeilen, die in Spalte H noch nichts eingetragen haben verarbeiten.
- Dazu könnte man vorher genau die per Filter finden und dann als Block kopieren.

- Wäre das ein machbarer Weg? (aber nicht mehr heute.)

LG UweD


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 08.12.2015 11:37:22

Hallo Uwe,

sorry komme erst jetzt dazu.

Das Makro funktioniert mit dem neuen Code nicht.
Es kommt #BEZUG! und die Daten werden 3x eingefügt.
D.h. bei 340 Einträgen kommen 1200 Einträge in die neue Liste.

Deine Idee mit dem "übernommen" ist nicht schlecht, jedoch kommen pro XLSM zwischen 100 und 250 neue Datensätze hinzu. Insgesamt habe ich zum Schluss ca. 25 XLSM, da wird das Kopieren etwas mühselig.
Der neue Datensatz wird auch gleich von 4 Personen weiter bearbeitet. In die nächsten Spalten kommen dann DATUM, NAME, BEMERKUNG usw.

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: UweD
Geschrieben am: 08.12.2015 13:00:08

Also bei mir kommt kein #Bezug! Fehler.

Ich ziehe mich deshalb zurück

Gruß UweD


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 08.12.2015 15:32:30

Hier mal meine Variante.
Einfach

Sub Bearbeiten ersetzen.
Der Rest bleibt gleich.
Sub Bearbeiten()
  Sheets("ACTION").Select
      Dim Ez1 As Long    'erste Zeile 
    Dim Lz1 As Long    'letzte Zeile (wird ermittelt)
    Dim Spalte1 As String
    Dim Spalte2 As String
    Spalte1 = "A"
    Spalte2 = "E"
    Spalte3 = "H"
    Ez1 = ActiveSheet.Cells(Rows.Count, Spalte3).End(xlUp).Row + 1    'ermittelt erste Zeile
    Lz1 = ActiveSheet.Cells(Rows.Count, Spalte2).End(xlUp).Row + 1 'ermitellt letzte Zeile
        Range("H1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-3]="""","""",""übernommen"")"
      Range("E1000000").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, 3).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    
    
    
    
ActiveSheet.Range(Spalte1 & Ez1 & ":F" & Lz1).Copy
  Windows("ZUSAMMENFASSUNG.xlsm").Activate
   Range("E1000000").Activate
  Selection.End(xlUp).Select
    ActiveCell.Offset(1, -4).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End Sub






Jetzt funktioniert es so, dass bei den Datensätzen in den ACTION-Sheets in Spalte H ein übernommen kommt.
Bei nächsten durchführen des Makros werden Dann alle Zeilen ab den letzten übernommen kopiert.
Das würde dann halt klappen wenn in den Excel-Sheets nur neue Zeilen hinzugefügt werden.

Gruß
Christoph


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 08.12.2015 15:43:44

du musst natürlich diesen Wert noch auf True setzen im anderen Makro.
wkbBook.Close False ' Oder True, wenn gespeichert werden soll


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 08.12.2015 16:59:59

Hallo Christoph,

das Makro bleibt bei "Selection.FillDown" stehen.

Fehlermeldung:
excel filldown methode des range objektes konnte nicht ausgeführt werden

Kann ich was ändern?
Habe Excel 365

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 08.12.2015 19:36:04

So vom essen zurück.
vielleicht kommen wir ja noch zu einer Lösung=)
Habe es jetzt besser gelöst und sollte nicht zu den Fehler kommen.
Hier jetzt nochmal alles.

Sub Zusammenfassen_CHRISTOPH()
'Const strPath As String = "C:\Users\acer\Desktop\Testherber\Archiv\" 'Pfad anpassen Dateien  _
sind
Const strPath As String = "J:\P_VA_VE_Cost_Reduction\TEAM_Ordner\01_Daten sammeln\06_Business  _
Case\" 'Pfad anpassen Dateien sind
    Dim strDateiname As String
    Dim wkbBook As Workbook
    Dim lngLastRowQ As Long
    Dim lngLastRowZ As Long
    Dim lngLastCol As Long
    Dim intCalc As Integer
    On Error GoTo Fin
    With Application
        .ScreenUpdating = False
        .AskToUpdateLinks = False
        .EnableEvents = False
        intCalc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    'strDateiname = Dir$(ThisWorkbook.Path & "\*.xls")
    strDateiname = Dir$(strPath & "*.xlsm")
    Do While strDateiname <> ""
        If strDateiname <> ThisWorkbook.Name Then
            Set wkbBook = Workbooks.Open(strPath & strDateiname)
        Call Bearbeiten
        
            wkbBook.Close True ' Oder True, wenn gespeichert werden soll
            Set wkbBook = Nothing
        End If
        strDateiname = Dir$()
    Loop
Fin:
    Set wkbBook = Nothing
    With Application
        .ScreenUpdating = True
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = intCalc
        .DisplayAlerts = True
    End With
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Sub Bearbeiten()
  Sheets("ACTION").Select
      Dim Ez1 As Long    'erste Zeile
    Dim Lz1 As Long    'letzte Zeile (wird ermittelt)
    Dim Spalte1 As String
    Dim Spalte2 As String
    Dim Zeile%
    Dim x
    Spalte1 = "A"
    Spalte2 = "E"
    Spalte3 = "H"
    Ez1 = ActiveSheet.Cells(Rows.Count, Spalte3).End(xlUp).Row + 1    'ermittelt erste Zeile
    Lz1 = ActiveSheet.Cells(Rows.Count, Spalte2).End(xlUp).Row + 1 'ermitellt letzte Zeile

For Zeile = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row To 1 Step -1
    If Cells(Zeile, 5) <> "" Then
  Cells(Zeile, 8) = "übernommen"

        End If
Next
    
    
    
    
ActiveSheet.Range(Spalte1 & Ez1 & ":F" & Lz1).Copy
  Windows("MUSTER.xlsm").Activate
   Range("E1000000").Activate
  Selection.End(xlUp).Select
    ActiveCell.Offset(1, -4).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End Sub



  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 10.12.2015 09:00:54

Hallo Chriatoph,

das Makro bleibt stehen.

Fehlermeldung: Error 9: außerhalb des gültigen Bereichs

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 10.12.2015 10:21:21

Hallo Christoph,

sorry, das Makro läuft doch, habe den Namen der MUSTER.xlsm geändert.

Werde das Makro jetzt mal im laufe der Datenerfassung ausprobieren.

Vielen Dank.

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 14.12.2015 08:31:05

Hallo Christoph,

das Makro läuft soweit.

Hätte jetzt aber gerne eine Änderung da ich zu viele Daten bekomme.

Ist es möglich in den Quelldateien.xlsm in die Spalte H ein „übernehmen“ zu schreiben damit nur diese Daten übernommen werden? Sind die Daten in der Zusammenfassung.xlsm soll das „übernehmen“ in der Quelldatei.xlsm durch „übernommen“ ersetzt werden. Dann hätte ich einen besseren Überblick.

Mit freundlichen Grüßen
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 14.12.2015 11:03:38

Hallo Manfred,
denke, dass das dir weiter helfen sollte.
Du willst ja das übernehmen händisch in den Quelldateien schreiben und diese Zeilen sollen dann ja kopiert werden oder?
Wenn du diesen Code in das vorhandene Modul kopierst und im Makro Zusammenfassen_Christoph das Call Bearbeiten durch Call Bearbeiten2 ersetzt sollte es klappen.

Sub Bearbeiten2()
 Dim Zeile%
  Sheets("ACTION").Select
For Zeile = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row To 1 Step -1
   If Cells(Zeile, 8) = "übernehmen" Then
    
ActiveSheet.Range("A" & Zeile & ":F" & Zeile).Copy
  Cells(Zeile, 8) = "übernommen"
  Windows("ZUSAMMENFASSUNG1.xlsm").Activate
   Range("E1000000").Activate
  Selection.End(xlUp).Offset(1, -4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,  _
SkipBlanks _
        :=False, Transpose:=False
            End If
Next
End Sub



  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 14.12.2015 15:11:20

Hallo Christoph,

das Ding läuft super. Vielen Dank für Deine Ünterstützung.

Jetzt können wir mit einer viel kleineren Liste arbeiten und nach und nach befüllen.

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 15.12.2015 12:20:51

Hallo Christoph,

ich nochmal.

Ich möchte gerne bis Spalte H erweitern.

ActiveSheet.Range("A" & Zeile & ":F" & Zeile).Copy 'anstatt F ein H

Ist das das einzige was ich beachten muss ? Oder ist da nochmehr ?

Ich möchte nichts riskieren bevor es mir die Blätter zerbröselt.

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 15.12.2015 23:32:42

Hallo Manfred,
ist natürlich nicht das einzige da in Spalte H ja etwas vom Makro rein geschrieben wird, bzw. seit der letzten Version, ja auch von dir selber. Übernommen/übernehmen steht dort ja. Denke ja nicht, dass du diese Spalte haben willst oder?


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 17.12.2015 08:44:23

Hallo Christoph,

ich habe alle Listen angepasst, die übernommen/übernehmen stehen jetzt in Spalte I.

Ich denka das stimmt so.

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 10.12.2015 13:03:04

Hallo Christoph,

ich noch mal.
Was muss ich ändern wenn ich jetzt bis Spalte G übernehmen muss ?

Habe noch eine Spalte zugefügt in H kann das Übernommen bleiben.

ActiveSheet.Range(Spalte1 & Ez1 & ":G" & Lz1).Copy

Muss ich noch was ändern ?

Bekomme jetzt ERROR: 13 Typen unverträglich

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 10.12.2015 15:20:27

Hallo Manfred,
das sollte eigentlich klappen.
Wo bekommst du die Fehlermeldung?

Gruß Christoph


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 10.12.2015 15:26:59

Hallo Christoph,

sorry, falscher Alarm, habe den Namen angepasst.

Läuft bis jetzt alles super.

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 08.12.2015 16:49:11

Hallo Uwe,

recht herzlichen Dank für deine Hilfe.

Du hast mir aber trotzdem weitergeholfen die Makros besser zu verstehen.

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: UweD
Geschrieben am: 07.12.2015 11:38:28

Hallo

Ich denke du verwechselt Mappen und Sheets

- > Mappen sind Exceldateien, die Tabellenblätter (Sheets) enthalten



also der erste Lauf könnte so aussehen...
 Sub Zusammen()
    On Error GoTo Fehler
    Dim LR0%, LR1%
    Dim TB0, TB1
    Dim strPath$, strExt$, strFile$
    Set TB0 = ThisWorkbook.ActiveSheet
    strPath = "C:\Temp\ABC\" 'Pfad des Verzeichnisses ggf. anpassen
    strExt = "*.xlsx"        'Dateiextension ggf. anpassen
    strFile = Dir(strPath & strExt) 'erster Treffer
    Do While Len(strFile) > 0
        Workbooks.Open FileName:=strPath & strFile
        For Each TB1 In Worksheets ' Alle Tabellenblätter prüfen
            If InStr(TB1.Name, "ACTION") > 0 Then
                LR1 = TB1.Cells.SpecialCells(xlCellTypeLastCell).Row
                LR0 = TB0.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                TB1.Range("A2:F" & LR1).Copy TB0.Cells(LR0, 1)
            End If
        Next TB1
        Workbooks(strFile).Close savechanges:=False
        strFile = Dir() 'nächster Treffer
    Loop

    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

gruß UweD


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 07.12.2015 11:53:18

Habe einmal etwas vertauscht-> Laufzeitfehler
hier die laufende Variante.

Sub Main()
Const strPath As String = "C:\Users\acer\" 'Pfad anpassen Dateien sind
    Dim strDateiname As String
    Dim wkbBook As Workbook
    Dim lngLastRowQ As Long
    Dim lngLastRowZ As Long
    Dim lngLastCol As Long
    Dim intCalc As Integer
    On Error GoTo Fin
    With Application
        .ScreenUpdating = False
        .AskToUpdateLinks = False
        .EnableEvents = False
        intCalc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    'strDateiname = Dir$(ThisWorkbook.Path & "\*.xls")
    strDateiname = Dir$(strPath & "*.xlsm")
    Do While strDateiname <> ""
        If strDateiname <> ThisWorkbook.Name Then
            Set wkbBook = Workbooks.Open(strPath & strDateiname)
        Call Bearbeiten
        
            wkbBook.Close False ' Oder True, wenn gespeichert werden soll
            Set wkbBook = Nothing
        End If
        strDateiname = Dir$()
    Loop
Fin:
    Set wkbBook = Nothing
    With Application
        .ScreenUpdating = True
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = intCalc
        .DisplayAlerts = True
    End With
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Sub Bearbeiten()
  Sheets("ACTION").Select
      Dim Ez1 As Long    'erste Zeile (hast Du vorgegeben)
    Dim Lz1 As Long    'letzte Zeile (wird ermittelt)
    Dim Spalte1 As String
    Dim Spalte2 As String
    Spalte1 = "A"
    Spalte2 = "F"
    Ez1 = 2      'Vorgabe
    Lz1 = ActiveSheet.Cells(Rows.Count, Spalte2).End(xlUp).Row  'ermitellt letzte Zeile
ActiveSheet.Range(Spalte1 & Ez1 & ":F" & Lz1).Copy
  Windows("ZUSAMMENFASSUNG.xlsm").Activate
   Range("F1000000").Activate
  Selection.End(xlUp).Select
    ActiveCell.Offset(1, -5).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub



  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 07.12.2015 12:26:18

Hallo Christoph,

im Macro "Bearbeiten" schreibst du Windows("ZUSAMMENFASSUNG.xlsm").Activate

Ich Arbeite aber schon mit dieser Exceldatei. Warum willst du sie activieren ? Ist das ein Fehler ?

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 07.12.2015 12:34:41

Du musst das Makro "Main" starten.
Dieses greift dann auf Makro "Bearbeiten" zu.
Da das Makro "Main" alle *.xlsm Dateien nach und nach öffnet muss ich die Tabelle Zusammenfassung.xlsm wieder aufrufen, da ja dort die Daten hineinkopiert werden sollen?!?!
Lässt du diese Zeile weg, werden die Daten in jeder Tabelle wieder hineinkopiert, sozusagen verdoppelt.


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 07.12.2015 11:54:36

Hallo Uwe,

das Makro läuft gut. Habs aber noch nicht richtig getestet.

Hab mich aber mit den Formaten falsch ausgedrück, jetzt kommen nur die Formeln.
Ich benötige aber die Werte und Texte.

Was muss ich anpassen ?

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Christoph Zahn
Geschrieben am: 07.12.2015 12:04:11

Bei meiner Variante werden gleich Werte eingefügt.


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: UweD
Geschrieben am: 07.12.2015 12:17:24

Hallo nochmal


hab meine Variante auch angepasst.

Die von Christoph ist ja ähnlich aufgebaut.

Bei mir werden je Datei alle Sheets durchsucht (Wenn mehrere ACTIONxx-Blätter darin vorhanden sind)
Wenn das nicht erforderlich ist, wird der Code auch kürzer und schneller.

 Sub Alle_Blätter_alle_Dateien()
    On Error GoTo Fehler
    Dim LR0%, LR1%
    Dim TB0, TB1
    Dim strPath$, strExt$, strFile$
    Set TB0 = ThisWorkbook.ActiveSheet
    strPath = "C:\Temp\ABC\" 'Pfad des Verzeichnisses ggf. anpassen
    strExt = "*.xlsx"        'Dateiextension ggf. anpassen
    strFile = Dir(strPath & strExt) 'erster Treffer
    Do While Len(strFile) > 0
        If strFile <> ThisWorkbook.Name Then
            Workbooks.Open FileName:=strPath & strFile
            For Each TB1 In Worksheets ' Alle Tabellenblätter prüfen
                If InStr(TB1.Name, "ACTION") > 0 Then
                    LR1 = TB1.Cells.SpecialCells(xlCellTypeLastCell).Row
                    LR0 = TB0.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                    TB1.Range("A2:F" & LR1).Copy
                    With TB0.Cells(LR0, 1)
                        .PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
                            , SkipBlanks:=False, Transpose:=False 'Formate
                        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False 'Werte
                        Application.CutCopyMode = False
                    End With
                End If
            Next TB1
            Workbooks(strFile).Close savechanges:=False
        End If
        strFile = Dir() 'nächster Treffer
    Loop

    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub


Gruß UweD


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: Manfred
Geschrieben am: 07.12.2015 12:36:33

Hallo Uwe,

in jeder Exceldatei ist nur ein Blatt mit dem Namen "Action".
Alle Werte und Texte sind mit Formeln zusammenfefügt.
Wenn ich jetzt dein Makro laufen lasse bekomme ich nur #BEZUG!
Es beginnt auch nicht immer bei A2 auch wenn die Tabelle leer ist.

Gruß
Manfred


  

Betrifft: AW: Daten zusammenfügen und vergleichen von: UweD
Geschrieben am: 07.12.2015 13:14:57

Hab auf nur ein ACTION-Blatt abgeändert.

- Läuft mit meinen 3 Spieldateien so wie gewollt.
= Formeln werden durch Werte ersetzt und Formate der Zellen werden ebenfalls copiert

- Das Makro ist in der ZUSAMMENFASSUNG.xlsm enthalten, in der auch die Daten gesammelt werden.


Es beginnt auch nicht immer bei A2 auch wenn die Tabelle leer ist.

kann es sein, dass du beim spielen die Daten rauslöschst, solltest vorher mal speichern, dann wird die erste Freie Zeile auch richtig erkannt..

Sub Alle_Blätter_alle_Dateien()
    On Error GoTo Fehler
    Dim LR0%, LR1%
    Dim TB0, TB1
    Dim strPath$, strExt$, strFile$
    Set TB0 = ThisWorkbook.ActiveSheet
    strPath = "C:\Temp\ABC\" 'Pfad des Verzeichnisses ggf. anpassen
    strExt = "*.xlsx"        'Dateiextension ggf. anpassen
    strFile = Dir(strPath & strExt) 'erster Treffer
    Do While Len(strFile) > 0
        If strFile <> ThisWorkbook.Name Then
            Workbooks.Open Filename:=strPath & strFile
            Set TB1 = ActiveWorkbook.Sheets("ACTION")
            LR1 = TB1.Cells.SpecialCells(xlCellTypeLastCell).Row
            LR0 = TB0.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
            TB1.Range("A2:F" & LR1).Copy
            With TB0.Cells(LR0, 1)
                .PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
                    , SkipBlanks:=False, Transpose:=False 'Formate
                .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False 'Werte
                Application.CutCopyMode = False
            End With
            Workbooks(strFile).Close savechanges:=False
        End If
        strFile = Dir() 'nächster Treffer
    Loop

    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub



 

Beiträge aus den Excel-Beispielen zum Thema "Daten zusammenfügen und vergleichen"