VBA To Copy List To Merged Columns

[smillshome]

Good afternoon all,

I would be grateful if someone could help me with this problem:

I have 2 sheets, Sheet1 has a list in column A of cost centre numbers:

A

250
500
1201
1202
1203

Sheet2 has the merged cells for this list starting with column C

A B C:D E:F G:H etc

How can I get the list from Sheet1 to populate the merged cells in Sheet2

The list on Sheet1 will change in length over time as we add more cost centres to it.

I found a snippet of code elsewhere but was unable to get it to work with the merged cells.

Any help would be appreciated.

Thank you.

 

[Sahak]

Hi smillshome ,


One of easy ways is to have a formula in merged sales in sheet2:
In C1 (which is merged C & D)
=Sheet1!A1
and copy down

 

[smillshome]

Hi Sahak,

Thanks for that.

However, the list of cost centres on Sheet1 is created using the following formula;

Sub Create_CC_List()
'
'create a cost centre list
Dim rng As Range
    Dim Ash As Worksheet
    Dim Cws As Worksheet
    Dim Rcount As Long
    Dim Rnum As Long
    Dim FilterRange As Range
    Dim FieldNum As Integer
    Dim NewWS As Worksheet
 
    'Set filter sheet, you can also use Sheets("MySheet")
    Set Ash = Sheets("HPL CC")
    'Set filter range and filter column (column with names)
    Set FilterRange = Ash.Range("A5:Q" & Ash.Rows.Count)
    FieldNum = 2    'Filter column = B because the filter range start in column B
    'Add a worksheet for the unique list and copy the unique list in A1
    Set Cws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    FilterRange.Columns(FieldNum).AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=Cws.Range("A1"), _
            CriteriaRange:="", Unique:=True
 
    'Remove duplicates and sort in ascending order
 
    Columns("A:A").Select
    Cws.Sort.SortFields.clear
    Cws.Sort.SortFields.Add Key:=Range("A1:A1000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Cws.Sort
        .SetRange Range("A1:A1000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("A:A").Select
    Cws.Range("$A$1:$A$1000").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A1").Select

And before each update, Sheet1 is deleted and re-created.