Tabellenblätter vergleichen und abgleichen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
könnte es so gehen?
Wie von Dir beschrieben, wird jede Zeile der Datei1 mit den Zeilen der Datei2 verglichen.
Ist die Zeile aus Datei1 nicht in Datei2 vorhanden,
wird die komplette Zeile aus Datei1 an die gleiche Stelle nach Datei2 kopiert.
Die Dateinamen und die Tabellennamen, musst Du natürlich anpassen.
Beide Dateien müssen in der gleichen Instanz geöffnet sein.

Sub AbgleichDatei2()
Dim DateiTab1 As Worksheet, DateiTab2 As Worksheet
Dim rngRange As Range, rngRange2 As Range
Dim strString1 As String, strString2 As String
Dim booVorhanden As Boolean

Set DateiTab1 = Workbooks("Mappe1.xls").Sheets("Tabelle1") 'Datei1 
Set DateiTab2 = Workbooks("Mappe2.xls").Sheets("Tabelle1") 'Datei2 

With Application
 .ScreenUpdating = False
 .EnableEvents = False
    
    For Each rngRange In DateiTab1.UsedRange.Columns(1).Cells
      strString1 = Join(.Transpose(.Transpose(rngRange.EntireRow)), ";")
      
      For Each rngRange2 In DateiTab2.UsedRange.Columns(1).Cells
       strString2 = Join(.Transpose(.Transpose(rngRange2.EntireRow)), ";")
       If strString2 = strString1 Then: booVorhanden = True: Exit For
      Next rngRange2
    
      If booVorhanden = False Then
       rngRange.EntireRow.Copy DateiTab2.Range(rngRange.Address)
      End If
      
      booVorhanden = False
    Next rngRange
 
 .ScreenUpdating = True
 .EnableEvents = True
End With
End Sub

Gruß Tino

Option Explicit Sub AbgleichDatei2() Dim Datei2 As Workbook Dim DateiTab1 As Worksheet, DateiTab2 As Worksheet Dim rngRange As Range, rngRange2 As Range Dim strString1 As String, strString2 As String Dim booVorhanden As Boolean 'hier den Dateipfad anpassen. Set Datei2 = CreateObject("E:\1 Forum\Mappe2.xls") Set DateiTab1 = Workbooks("Mappe1.xls").Sheets("Tabelle1") 'Datei1 Set DateiTab2 = Datei2.Sheets("Tabelle1") 'Datei2 With Application .ScreenUpdating = False .EnableEvents = False For Each rngRange In DateiTab1.UsedRange.Columns(1).Cells strString1 = Join(.Transpose(.Transpose(rngRange.EntireRow)), ";") For Each rngRange2 In DateiTab2.UsedRange.Columns(1).Cells strString2 = Join(.Transpose(.Transpose(rngRange2.EntireRow)), ";") If strString2 = strString1 Then: booVorhanden = True: Exit For Next rngRange2 If booVorhanden = False Then DateiTab2.Range(rngRange.Address).EntireRow.Value = rngRange.EntireRow.Value End If booVorhanden = False Next rngRange .ScreenUpdating = True .EnableEvents = True End With End Sub

Beliebteste Forumthreads (12 Monate)

Tabellenblätter vergleichen und abgleichen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellenblätter vergleichen und abgleichen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread