Werte vers. AB zusammenziehen und abgleichen

Hallo zusammen,
vielleicht hat jemand eine Idee, wie ich folgendes Problem abfangen könnte:
Ich habe 16 Arbeitsblätter, die ersten drei sind mit Parameterdaten gefüllt, die restlichen sind monatlich unterschiedlich. Ich muss, bevor ich Berechnungen durchführen kann überprüfen, mit welchen Daten die Arbeitsblätter befüllt sind. Ich stelle mir das so vor:
Arbeitsblätter sollen hinsichtlich der Werte in der Spalte mit dem Titel "SID" geprüft werden. Alle Werte, welche in den Spalten mit dem Titel "SID" gefunden wurden sollen von Dopplungen befreit werden. Die Grundmenge soll in der "Hilfstabelle" (Spalte J) ausgegeben werden.
Als Hilfestellung habe ich nur die Titel der Arbeitsblätter, da diese konstant sind. Die Spalten "SID" in den jeweiligen Arbeitsblättern wandern hin und her (allerdings auf A-Q beschränkt). In der Beispieldatei habe ich das Problem skizziert.
https://www.herber.de/bbs/user/115307.xlsx
Ein Makro wäre super, dass automatisch die Grundmenge der SID ausgibt, sodass ich direkt damit weiterarbeiten kann.
Vielen Dank schonmal.
Liebe Grüße,
Kiki

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hi
Vielleicht so...

Sub t()
Dim WS1 As Worksheet, WS2 As Worksheet, intSpalte As Integer
Application.ScreenUpdating = False
Set WS1 = Worksheets("Hilfstabelle")
WS1.Range("J4:J" & WS1.Cells(Rows.Count, 10).End(xlUp).Row + 1).ClearContents
WS1.Range("K4:K" & WS1.Cells(Rows.Count, 11).End(xlUp).Row + 1).ClearContents
For Each WS2 In ThisWorkbook.Worksheets
If WS2.Name  "Hilfstabelle" And WS2.Name  "BA" And WS2.Name  "Overview" Then
If WorksheetFunction.CountIf(WS2.Rows(1), "SID") > 0 Then
intSpalte = Application.Match("SID", WS2.Rows(1), 0)
WS2.Range(WS2.Cells(2, intSpalte), WS2.Cells(Rows.Count, intSpalte).End(xlUp)).Copy _
WS1.Cells(Rows.Count, 10).End(xlUp).Offset(1, 0)
End If
If WorksheetFunction.CountIf(WS2.Rows(1), "AID") > 0 Then
intSpalte = Application.Match("AID", WS2.Rows(1), 0)
WS2.Range(WS2.Cells(2, intSpalte), WS2.Cells(Rows.Count, intSpalte).End(xlUp)).Copy _
WS1.Cells(Rows.Count, 11).End(xlUp).Offset(1, 0)
End If
End If
Next WS2
WS1.Range("J3:J" & WS1.Cells(Rows.Count, 10).End(xlUp).Row + 1).RemoveDuplicates Columns:=1,  _
Header:=xlYes
WS1.Range("K3:K" & WS1.Cells(Rows.Count, 11).End(xlUp).Row + 1).RemoveDuplicates Columns:=1,  _
Header:=xlYes
End Sub

cu
Chris

Beliebteste Forumthreads (12 Monate)

Werte vers. AB zusammenziehen und abgleichen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread