Zusammenfassung von Tabellen

Hallo an alle Forumteilnehmer,
habe eine Exelliste mit 20 Tabellenblätter als Vorlage.
Öffne mir dann eine ältere Datei und lasse diese miteinander vergleichen.
Lege mir dann zu jeder Tabelle eine Diff-Tabelle an um mir die differenzen anzeigen zu lassen.
Fasse dann die Differenzen in einer Ges-Diff zusammen.
Hier ist mein Problem. Es kommt immer wieder vor, dass er mir eine Diff-xx anlegt , auch einen Inhalt hat,
diesen dann aber nicht in Ges-Diff überträgt.
Was mich dann aber zur Verzeiflung bringt ist dass er die Diff-xxx dann aber löscht.
D.h. er findet diese zur Bearbeitung... Muss also was mit der Zusammenfassung zu tun haben...
For Each wks In ActiveWorkbook.Worksheets
'MsgBox wks.Name
If Left(wks.Name, 4) = "Diff" Then
wksDiff.Name = ActiveSheet.Name
wks.UsedRange.Copy
With Sheets("Ges-Diff")
lrow = .Range("B65536").End(xlUp).Row + 1
.Range("A" & lrow) = wks.Name
.Range("B" & lrow).PasteSpecial
End With
Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
End If
Next
Verzweifelter Gruß
Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub a() Dim wks As Worksheet Dim wksAktiv As Worksheet Set wksAktiv = Worksheets("Ges-Diff") For Each wks In ActiveWorkbook.Worksheets If Left(wks.Name, 4) = "Diff" Then wks.UsedRange.Copy With wksAktiv lrow = .Range("B65536").End(xlUp).Row + 1 .Range("A" & lrow) = wks.Name .Range("B" & lrow).PasteSpecial End With Application.DisplayAlerts = False wks.Delete Application.DisplayAlerts = True End If Next End Sub

Hallo Stefan
starte mal folgendes Makro auf der Zusammenfassen-Seite
(das gleiche Makro wie gehabt, nur mit MsgBox-Ausgabe)
und schau dir mal genau an, was bei der Diff-Test-Tabelle passiert:

Sub Zusammenfassen()
' Zusammenfassung
Dim wks As Worksheet
Dim wksAktiv As Worksheet
Set wksAktiv = Worksheets("Ges-Diff")
For Each wks In ActiveWorkbook.Worksheets
If Left(wks.Name, 4) = "Diff" Then
MsgBox wks.Name
wks.UsedRange.Copy
With wksAktiv
lrow = .Range("B65536").End(xlUp).Row + 1
MsgBox "Zeile " & lrow
.Range("A" & lrow) = wks.Name
.Range("B" & lrow).PasteSpecial
End With
Application.DisplayAlerts = False
MsgBox wks.Name & (" wird gelöscht")
Rem wks.Delete
Application.DisplayAlerts = True
End If
Next
' Sheet Differenz auswählen
'Sheets("Ges-Diff").Select
End Sub

Warum hier nicht in B sondern in C kopiert wird ist mir auch rätselhaft.
Auf alle Fälle stimmt danach die lrow-Variable nicht mehr und die
korrekt kopierten Daten werden durch das nächste Sheet überschrieben.
Keine Erklärung, aber ein Workaround: lösche auf dem Diff-Test-Sheet
einmal die A-Spalte und füge sie danach wieder ein. Bei mir klappts dann ...
Gruß
Klaus

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread