macro to Copy Data to applicable Sheet

[howard]

I have data in Cols A:H on sheets "Inventory" The branch names are in Col G

I have various sheet names for each of the branch names

I would like a macro to copy the data from A2 to the last row containing data on sheets "Inventory" for each branch name and paste this in the applicable sheet name from A25 onwards


Your assistance in this regard is most appreciated

 

[MickG]

Try:-

[COLOR="Navy"]Sub[/COLOR] MG12Dec50
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("G2"), Range("G" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        ReDim ray(1 To Rng.Count, 1 To 8)
        [COLOR="Navy"]For[/COLOR] Ac = 1 To 8
            ray(1, Ac) = Dn.Offset(, -7 + Ac)
        [COLOR="Navy"]Next[/COLOR] Ac
        .Add Dn.Value, Array(ray, 1)
    [COLOR="Navy"]Else[/COLOR]
        Q = .Item(Dn.Value)
            Q(1) = Q(1) + 1
            [COLOR="Navy"]For[/COLOR] Ac = 1 To 8
                Q(0)(Q(1), Ac) = Dn.Offset(, -7 + Ac)
            [COLOR="Navy"]Next[/COLOR] Ac
        .Item(Dn.Value) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    Sheets(K).Range("A25").Resize(.Item(K)(1), 8).Value = .Item(K)(0)
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[howard]

Hi Mick

Thanks for help

I have tested your code on two sheets (still need to create the balance for the branch names)

It copies the data perfectly to the two sheets I had created, but then comes up with an error and highlights the code below

I guess that this error will be eliminated once I set up all the branch codes

 Sheets(K).Range("A25").Resize(.Item(K)(1), 8).Value = .Item(K)(0)

 

[MickG]

You're welcome
Yes, if you have not got the actual sheets with there related names you will get an error!!