Copy/Paste unique

Hi everyone,

Hope you are well!

I am hoping to find some help for my VBA Macro to help me save time!
In my excel, I have a list of clients nb and a list of products.
I must link my clients nb with my products. So that for each products I have a client nb attributed to it into a new column.

Client list is in column A: from Line 10 up to last non empty row.
Product list: from range C10 to I10 (number of lines up to last non empty row)

Here are the instructions for my macro:
USER TASK: 1. paste in column A clients unique nb (from line 10 to ...)
2. paste in column C to I unique data for each products (from line 10 to...)

MACRO:
3. copy the full range of products from C:I,
4. past it range L10 to R
5. add in column S the unique client nb
6. repeat the same until last unique client nb reached.

I hope it's clear, hope you can help!

Thanks a lot,

Kindest,
Florian

fmoro,

Be easier to help if you attach a sample worksheet with a few rows of "dummy" data AND show what you want the output to actually look like?

Hard to visualise from just a description

Ochimus

Hello,

Of course! Please find excel example from attachment.

Let me know if you have other questions!

Thanks for your help,

Kindest,
Florian

Hi,
Try

Option Explicit

Sub test()
Dim a, b, c As Variant
Dim lr, l, i As Long
    lr = Cells(Rows.Count, 1).End(xlUp).Row - 9
    a = Cells(10, 1).Resize(lr)
    b = Cells(10, 3).Resize(Cells(Rows.Count, 3).End(xlUp).Row - 9)
    c = Cells(10, 4).Resize(Cells(Rows.Count, 4).End(xlUp).Row - 9, 6)
    For i = 1 To UBound(a)
        Cells(10 + l, 12).Resize(UBound(b)) = b
        Cells(10 + l, 13).Resize(UBound(b)) = a(i, 1)
        Cells(10 + l, 14).Resize(UBound(c), UBound(c, 2)) = c
        l = l + UBound(c)
    Next
End Sub

Amazing! Thank you so much- I've used Millz and it works like a charm.

Hi again
I actually Liked Millz code very much
Concerning the speed for large amount of data this code could be faster!

Sub test2()
    Dim i As Long, lr, lr2 As Long
    Dim a As Variant
    Application.ScreenUpdating = False
    With ActiveSheet
        a = .Range("A10").CurrentRegion.Resize(, 10)
        lr2 = .Cells(Rows.Count, "c").End(xlUp).Row - 9
        For i = 2 To UBound(a)
            lr = .Cells(Rows.Count, "L").End(xlUp).Row
            Range("L" & lr + 1).Resize(lr2) = Application.Index(a, 0, 3)
            Range("M" & lr + 1).Resize(lr2) = a(i, 1)
            Range("N" & lr + 1).Resize(lr2, 6) = Application.Index(a, 0, Array(4, 5, 6, 7, 8, 9))
        Next
    End With
    Application.ScreenUpdating = True
End Sub