Læg værdi i dublet sammen

Option Base 1
Sub TælSammen()


    Dim A As Integer, B As Integer, Data As Variant, Res() As Variant
    Dim Gem As String
    B = Range("A65536").End(xlUp).Row    ' finder sidste række med data
    Data = Range("A1:C" & B)    ' Dublerende kolonne A , Vareart kolonne B og antal kolonne C
    ReDim Res(B, 3)    ' dim en tom variabel til resultat

            ' overskrifter
            Res(1, 1) = Data(1, 1)
            Res(1, 2) = Data(1, 2)
            Res(1, 3) = Data(1, 3)
            ' overskrifter slut
           
    For T = 2 To UBound(Data)
        For i = 2 To UBound(Res)
            If Res(i, 1) = Data(T, 1) And Res(i, 2) = Data(T, 2) Then
                Res(i, 3) = Res(i, 3) + Data(T, 3)
                GoTo Næste
            End If
           
            If Res(i, 1) = "" Then
                Res(i, 1) = Data(T, 1)
                Res(i, 2) = Data(T, 2)
                Res(i, 3) = Res(i, 3) + Data(T, 3)
                GoTo Næste
            End If
        Next
Næste:
    Next
  ' Vælg gemme ark

  Worksheets("Ark2").Range("A1:C" & B) = Res      'Skriver i A og D kolonnen
    'Range("A1:B" & B) = Res '  A, B og C kolonnen i valgt ark
End Sub

Hej kabbak

Jeg tror jeg fik udtrykt mig total dårlig. Koden virker men jeg har vist ikke fået det ordentligt forklaret hvor i mit problem ligger.

i kolonne B har jeg vare art. stående og i kolonne E antal, det er disse værdiger jeg kunne tænke mig blev flytter til kolonne J og K på samme ARK. Lagt dubletteren sammen fra kolonne B, som den nuværende kode gør, og så lægge tallene fra kolonne E sammen.

Jeg håber det var en bedre forklaring.

Kw

Option Base 1
Sub TælSammen()

    Dim A As Integer, B As Integer, Data As Variant, Res() As Variant
    Dim Gem As String
    B = Range("B65536").End(xlUp).Row    ' finder sidste række med data
    Data = Range("B1:C" & B)    ' Dublerende kolonne A , Vareart kolonne B og antal kolonne C
    ReDim Res(B, 2)    ' dim en tom variabel til resultat

            ' overskrifter
            Res(1, 1) = Data(1, 1)
            Res(1, 2) = Data(1, 2)
            ' overskrifter slut
           
    For T = 2 To UBound(Data)
        For i = 2 To UBound(Res)
            If Res(i, 1) = Data(T, 1) Then
                Res(i, 2) = Res(i, 2) + Data(T, 2)
                GoTo Næste
            End If
           
            If Res(i, 1) = "" Then
                Res(i, 1) = Data(T, 1)
                  Res(i, 2) = Res(i, 2) + Data(T, 2)
                GoTo Næste
            End If
        Next
Næste:
    Next

Range("J1:K" & B) = Res      'Skriver i J og K kolonnen
End Sub

Hej, kan ikke rigtig forstå det, koden tager stadig antallet fra kolonne C hvor jeg skal bruge at den tager det fra kolonne E. Der er et antal i kolonne C og D men dem skal jeg ikke have med over.

KW

Option Base 1
Sub TælSammen()


    Dim A As Integer, B As Integer, Data As Variant, Res() As Variant
    Dim Gem As String
    B = Range("B65536").End(xlUp).Row    ' finder sidste række med data
    Data = Range("B1:E" & B)    ' Dublerende kolonne A , Vareart kolonne B og antal kolonne C
    ReDim Res(B, 2)    ' dim en tom variabel til resultat

            ' overskrifter
            Res(1, 1) = Data(1, 1)
            Res(1, 2) = Data(1, 4)
            ' overskrifter slut
           
    For T = 2 To UBound(Data)
        For i = 2 To UBound(Res)
            If Res(i, 1) = Data(T, 1) Then
                Res(i, 2) = Res(i, 2) + Data(T, 4)
                GoTo Næste
            End If
           
            If Res(i, 1) = "" Then
                Res(i, 1) = Data(T, 1)
                  Res(i, 2) = Res(i, 2) + Data(T, 4)
                GoTo Næste
            End If
        Next
Næste:
    Next

Range("J1:K" & B) = Res      'Skriver i J og K kolonnen
End Sub

1000 tak for hjælpen det var lige den nød jeg ikke kunne knække :-)

KW