Copy and fill cell contents to first empty cell and autofill to last row of adjacent column

[Wedne5day1te]

I have a large spreadsheet with different columns with varyingnumbers of product item rows below each SKU heading. I have a routine whichcopies the product range and dumps this into column B in Sheets("Dump").This works ok.

Set ActSheet = ActiveSheet
ActSheet.Range("A" & Product &":" & "A" & LastRowColA).Copy
With Sheets("Dump")
.Range("B" & .Rows.Count).End(xlUp).Offset(1).PasteSpecialPaste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
End With
I then want to copy the SKU code which is the value in "SKURange"to the Dump worksheet column A into the first blank row in column A and autofillto the last row determined by the last row in the adjacent column B.
Thanks for your help

 

[PCL]

What do you mean by

the value in "SKURange"

is SKURange a name for a cell ?

 

[Wedne5day1te]

Yes it's the contents of a cell named SKU range which is the name of the active cell I select

 

[PCL]

OKAY
See next code
The Const are just there to make it working in my file

Option Explicit
Sub Test()
Const LastRowColA = 20
Const Product = 2
Dim ActSheet As Worksheet
Dim FR  As Integer, LR As Integer
    Set ActSheet = ActiveSheet
    ActSheet.Range("A" & Product & ":" & "A" & LastRowColA).Copy
    With Sheets("Dump")
        .Range("B" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, _
         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
         FR = .Range("A1").End(xlDown).Row
         LR = .Range("B" & Rows.Count).End(3).Row
         With Range(.Cells(FR + 1, "A"), .Cells(LR, "A"))
            .Cells(1, 1) = Range("SKURange")
            .FillDown
         End With
    End With
End Sub

 

[Wedne5day1te]

Merci beaucoup. Bonne soiree!

 

[PCL]

Merci toi aussi
Thank you you to

 

[Wedne5day1te]

Etonnant!. Vous etes mon Champion du Monde 2018!