Thema: Kopieren von zellen aus verschiedenen WS | Herbers Excel-Forum

Guten morgen,
ich stosse schon wieder an meine Grenzen und komme nicht weiter. Ich habe 3 Tabellenblaetter (Main, Tab1 und Tab2). In Tab1 und Tab2 sind verschiedene Artikel aufgefuehrt (Spalte A = Beschreibung, Spalte = Anzahl). In Main sollen die Tab1 und Tab2 verknueft werden und jeder Arktikel genau einmal aufgefuehrt sein (also keine dublikate) und die Anzahl summiert sein. Nach moeglichkeit soll das sub dynamisch sein, da immer wieder Artikel in Tab1 und Tab2 hinzu gefuegt werden. Hat jmd eine idee ?

Hallo Helge,
Artikelnummern gibt es in deinen Listen nicht? Eine Auswertung auf der Basis der Beschreibungen ist sicher fehlerträchtig.
Viele Grüße Klaus-Dieter

Online-Excel

Hi, stimmt mit einer Artikelnummer ist es wesentlich besser. Ich werde das in den Listen editieren.

Hallo Helge,
noch eine Frage, du schreibst etwas von einer Sub, also denkst du an eine VBA-Lösung?
Viele Grüße Klaus-Dieter

Online-Excel

Hallo,
versuche es mal mit diesem Code

Sub Liste_Mit_Summe()
Dim oDic As Object
Dim meAr()
Dim A As Long
Dim i As Integer

Set oDic = CreateObject("Scripting.Dictionary")
'Überschrift 
oDic("Beschreibung") = "Summe"

'Schleife über Tab1 und Tab2 
For i = 1 To 2

    With Sheets("Tab" & CStr(i)).UsedRange
        'Daten aus Spalte 1 und 2 
        meAr() = Range(.Columns(1), .Columns(2)).Value2
    End With
    'ab Zeile 2, 1 = Überschrift in der Tabelle 
    For A = 2 To Ubound(meAr)
     'Ist der Wert eine Zahl 
     If IsNumeric(meAr(A, 2)) Then _
     oDic(meAr(A, 1)) = oDic(meAr(A, 1)) + meAr(A, 2)
    Next A

Next i

With Sheets("Main")
    .Range("A:B").ClearContents
    .Range("A1").Resize(oDic.Count) = Application.Transpose(oDic.keys)
    .Range("B1").Resize(oDic.Count) = Application.Transpose(oDic.Items)
    .Range("A1:B1").Font.Bold = True
    .Columns("A:B").EntireColumn.AutoFit
End With

End Sub

Gruß Tino

Hey danke Tino, passt soweit. Hab da irgendwie den falschen Ansatz gehabt ;)
Wuensche euch noch einen schoenen Sonntag.

Dank dir Tino, so wollte ich das ... da war ich ja mit meiner loesung meilen entfernt ;) Wuensche dir noch einen schoenen Sonntag