Thread: Copy Selected range values for few times

Dear All,

I am new in this forum, but i hardly to get help from others people around, hope this forum can give me some suggestions. Thanks

Problem:
I wish to make a marco that can let me copy 5 items for 5 times using macro automatically.

Example:

I got 5 alphabets from A1 to A5, A B C D E . I wish I could make duplication for these 5 alphabets using one macro by running once can get all things done.

Expected Result:
A1 B1

A A
B A
C A
D A
E A
1 B
1 B
1 B
1 B
1 B
1 C
1 C
1 C
1 C
1 C

Try this...it will create 5 items in column B for every item in column A.

Code:

Sub DuplicateValues()
Dim cRange As Range

Set cRange = Range("A:A").SpecialCells(xlCellTypeConstants)

cRange.Copy Range("B1").Resize(cRange.Cells.Count * 5)
    
Columns("B:B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

End Sub

Thanks for the feedback. It is appreciated.

If that takes care of your need, use the Thread Tools menu to mark the this thread as [SOLVED].

Maybe just add this line as the last line of code:

Code:

Range("B1:B4").Insert xlShiftDown   'add this

End Sub

Erm Thanks a lot, one more last question. I already modify your code to suit my need, however I can't figure out the last part of my coding.

Process:
1. Raw data to be copied and duplicated in Sheet1.
2. Counts calculation base on cell's value
3. Relocate the data into another worksheet "Populated Data" and place at particular cells.

Problem occur:
4. Do data sorting on "Populated Data" worksheet, so that the outcome same as previous coding.
5. place at particular cells. < I should do the process here.

Do you have any idea? Thanks alot

Code:

Sub DuplicateValues()
Dim cRange As Range
Dim Counts As Integer

  'Raw Data at Sheet1
   Set cRange = Sheets("Sheet1").Range("A:A").SpecialCells(xlCellTypeConstants)
   
  'Duplicate base on cell's value
    Counts = Sheets("Control Panel").Range("E1").Text

  'Relocate the data in to Worksheet Populated Data and place at particular cells
    cRange.Copy Sheets("Populated Data").Range("C5").Resize(cRange.Cells.Count * Counts)
 
 '???  
    Sheets("Populated Data").Select
    Columns("C:C").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

End Sub

Maybe this:

Code:

Sub DuplicateValues()
Dim cRange As Range
Dim Counts As Long

'Raw Data at Sheet1
   Set cRange = Sheets("Sheet1").Range("A:A").SpecialCells(xlCellTypeConstants)
   
'Duplicate base on cell's value
    Counts = Sheets("Control Panel").Range("E1").Value

'Relocate the data in to Worksheet Populated Data and place at particular cells
    cRange.Copy Sheets("Populated Data").Range("C5").Resize(cRange.Cells.Count * Counts)
 
'Sort items so grouped items are together 
    Sheets("Populated Data").Range("C5:C" & Rows.Count).Sort Key1:=Range("C5"), _
        Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub

Thanks a lot, I got great experience with this excel forum, Thanks ya, JBeaucaire!
But the coding for the 4th part not working welL

Code:

 'Sort items so grouped items are together
    Sheets("Populated Data").Columns("C5:C" & Rows.Count).sort Key1:=Range("C5"), _
        Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

It only works when i change to

Code:

 'Sort items so grouped items are together
    Sheets("Populated Data").Columns("C:C").sort Key1:=Range("C5"), _
        Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

But the result come out is not what I want @@.
Anyway what does this coding means? Key1:=Range("C5")
Seem like I make changes on C5 to C1 like nothing happen.
Thanks for your suggestion and explanation in advance.

One typo in the code, corrected in post #7, try it again.

If that takes care of your need, use the Thread Tools menu to mark the this thread as [SOLVED].

(Also, use the blue "scales" icon in our posts to leave Reputation Feedback, it is appreciated. It is found across from the "time" in each of our posts.)