Copying row to another sheet and create unique code for duplicate - vba

Question

I would like to know how to manipulate my excel data as I need.
I have a table with rows and a lot of field I would like to select by hand some rows and to copy them to another sheet that has predefined column ordering those rows to fit my predefined column and to create an unique code for rows that I consider duplicate based on 2 two column.
This might not be very clear so I will explain more with photo:
here I have my table with rows I selected by hand, I would like to copy column H,I,K,AA,AJ to another sheet but in some specific order to fit my other table column:
I would like my AJ column in the Column A, my AA column in the Column E My column K in the Column F etc...
I Would also want to create a unique Key based on column F and I (for example here in the first image rows 17 to 21 would have the same key in the blue sheet in column B)
For the moment I am able to take my selected rows and copy the wanted column to another sheet.
I don't know how to reorder them to fit my template in the second sheet. I also don't know how to create a key and insert it to my second sheet for each combination of columns F and I of my first sheet.
Sub ajout_commande()
Set DataSheet = ThisWorkbook.Worksheets("0")
Dim a As Range, b As Range
Set a = Selection
i = Selection.Rows.Count
For Each b In a.Rows
DataSheet.Cells(2, 1).EntireRow.Insert
Next
Dim r1 As Range, r2 As Range, r3 As Rang, r4 As Range, r5 As Range, res_range As Range
Let copyrange1 = "I1" & ":" & "I" & i
Let copyrange2 = "K1" & ":" & "K" & i
Let copyrange3 = "L1" & ":" & "L" & i
Let copyrange4 = "AA1" & ":" & "AA" & i
Let copyrange5 = "AJ1" & ":" & "AJ" & i
Set r1 = a.Range(copyrange1)
Set r2 = a.Range(copyrange2)
Set r3 = a.Range(copyrange3)
Set r4 = a.Range(copyrange4)
Set r5 = a.Range(copyrange5)
Set res_range = Union(r1, r2, r3, r4, r5)
res_range.Copy
DataSheet.Cells(2, 1).PasteSpecial xlPasteValues
End Sub
If this is to complicate to implement or impossible please tell me in comment so that I try to find another method. I am new to VBA and am trying to help my colleagues by simplifying their work.
Thanks.

Answer 1

Maybe try something like this.
It need some adjustements (especially in cells to copy)
Dim UniqueKeyArray() As String
Dim Counter As Long
Sub test()
Dim aRows As Range, aCell As Range
Dim Ws As Worksheet
Dim i As Long
Set Ws = ThisWorkbook.Sheets("SomeName")
ReDim UniqueKeyArray(0 To 1, 1 To 1)
For i = 1 To Selection.Areas.Count 'loop through selection
For Each aRows In Selection.Areas(i).Rows 'loop through rows of selection
For Each bCell In aRows.Columns(1).Cells 'loop through cells in column one
With Ws
.Cells(2, 1).EntireRow.Insert
'adjust offset to get source data you need
'adjust cells(x,y) to put data where you want it
.Cells(2, 2) = bCell.Offset(0, 2)
.Cells(2, 3) = bCell.Offset(0, 3)
.Cells(2, 4) = bCell.Offset(0, 5)
.Cells(2, 5) = bCell.Offset(0, 6)
.Cells(2, 1) = "'" & UniqueKey(bCell.Text) ' "'" added to prevent excel trim leading 000..
End With
Next bCell
Next aRows
Next i
'reset variables. This way you always start unique key from 1
Counter = 0
Erase UniqueKeyArray
End Sub
Function UniqueKey(SourceVal As String) As String
'creates unique key based on source string
Dim i As Long
For i = 1 To UBound(UniqueKeyArray, 2)
If UniqueKeyArray(1, i) = Format(SourceVal, "0000000000") Then
'if string is same you get unique key created before
UniqueKey = UniqueKeyArray(1, i)
Exit Function
End If
Next i
'if string is new then new unique key is created
Counter = Counter + 1
ReDim Preserve UniqueKeyArray(0 To 1, 1 To Counter)
UniqueKey = Format(Counter, "0000000000") 'adjust format to fit your needs
UniqueKeyArray(0, Counter) = SourceVal
UniqueKeyArray(1, Counter) = UniqueKey
End Function