Combinaties maken uit 2 bestanden

[blmsth]

Goede morgen
Ik heb 2 bestanden met data met telkens 1 gezamenlijk veld (artikelcategorie).
Bestand 1: artikelnummer en artikelcategorie
Bestand 2: artikelcategorie en leverancierscode(s)
Ik wens nu achter elk artikelnummer (uit bestand 1) een leverancierscode te plaatsen (uit bestand 2). Probleem is dat sommige artikelnummers moeten gedupliceerd worden, als er voor die artikelcategorie meerdere leverancierscodes bestaan.
Hoe kan ik dit automatiseren, zodat ik niet manueel artikelnummers moet dupliceren voor het aantal leverancierscodes? Bestanden in bijlage
Thx
Tom

 

[Cobbe]

Ik heb de 2 tabellen op 1 tab gezet.
Vul nu eens handmatig in wat er wanneer moet gebeuren.

 

[blmsth]

Zie bijlage.

Mvg
Tom

 

[snb]

Heb je zelf enig idee? of zoek je gewoon een goekope oplossing ?

 

[Cobbe]

Ik heb een voorstel, indien ok kun je het in je eigen bestand toepassen.

 

[blmsth]

@ snb -> dacht zelf aan verticaal zoeken en daarna lijn per lijn copiëren, maar denk dat dit sneller kan.
@ cobbe -> artikelnummers worden blijkbaar niet gedupliceerd (toegevoegd) als er meer dan 1 leverancierscode bestaat...dit moet de bedoeling zijn (zie mijn voorbeeld met artikelcode 10 -> hiervoor bestaan 17 leverancierscodes dus artikelnummer 10 moet in totaal 17x bestaan.

 

[snb]

@ snb -> dacht zelf aan verticaal zoeken en daarna lijn per lijn copiëren, maar denk dat dit sneller kan
hiervoor bestaan 17 leverancierscodes dus artikelnummer 10 moet in totaal 17x bestaan.

Van die formule ga je niet blij worden.
Je gaat 47010 regels nodig hebben in jouw geval.

 

[Cobbe]

Deze brengt misschien soelaas.

Sub Cobbe()
    Range("B4:C4000").ClearContents
    Application.ScreenUpdating = False
    For Each cl In Range("I4:I40")
        r = Range("C2").End(xlDown).Offset(1, 0).Row
           For y = 1 To cl.Offset(, -1)
            Cells(r, "C") = cl
            r = r + 1
        Next y
    Next

    For Each cl In Range("C4:C4000")
        If cl <> cl.Offset(-1, 0) Then
            Set r = Range("I4:I40").Find(cl)
            If Not r Is Nothing Then
                Range(Cells(r.Row, 10), Cells(r.Row, 10 + Cells(r.Row, 8))).Copy
                Cells(cl.Row, "B").PasteSpecial Paste:=xlPasteAll, Transpose:=True
            End If

        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[WHER]

Of deze: