Copy Paste Data in Same column for multiple time

[Solved/Closed]
Report
Posts
3
Registration date
Saturday December 15, 2012
Status
Member
Last seen
December 18, 2012
-
 sree -
Hello,

i need following manipulation....

Data Before
Column "A"

123456
123456
123456
123456
123456

( After )Column "A" (After copy paste same data 5 times 10 times or whatever)....e.g. here 3 times

123456
123456
123456
123456
123456
123456
123456
123456
123456
123456
123456
123456
123456
123456
123456

Thanks.....





Output

2 replies

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
so just copy all the cells in one column "n" number of times where "n" would depend on how many times you want to copy?
9
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2821 users have said thank you to us this month

Posts
3
Registration date
Saturday December 15, 2012
Status
Member
Last seen
December 18, 2012

e.g. I want to copy A1:A20, "n" number of time below the same column...repeatedly.... and "n" is the value which I can enter in input box.

hope you understand what I want.....?


thanks riz,
Posts
3
Registration date
Saturday December 15, 2012
Status
Member
Last seen
December 18, 2012

there was a short problem in the line of

maxCopy = (rowsAvailable - (rowsAvailable Mod lastRowForCopy)) / lastRowForCopy......which I deleated :-)

and condition
If (maxCopy < numberOfCopies) which actually should be ">" instead of "<"

i modified that and it worked as exactly I was expected........

thanks a ton....you are the best :-) Full marks
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
try this updated code. earlier one had few other issues too I deleted earlier code to remove confusion


Option Explicit 

Public Sub copyRange() 

Dim copyRangeAddress          As String   ' range address to copy 
Dim copyRange                 As Range    ' range to copt 
Dim numberOfCopies            As Integer  ' how many times to copy 
Dim lastRowForCopy            As Long     ' the last row id that is to be copied 
Dim lastRowInUse              As Long     ' rows already in use 
Dim maxCopy                   As Integer  ' number of times range is to be copied 
Dim rowsAvailable             As Long     ' rows available for copy 
Dim copyCounter               As Integer  ' counter to keep track how many times range has been copied 
Dim firstCellToCopy           As Range    ' first cell of the copied range 
Dim lastCellToCopy            As Range    ' last cell of the copied range 

   lastRowInUse = getItemLocation("*", Columns(1)) 
   copyRangeAddress = InputBox("Enter range to be copied", "Copy Range", "A1:A" & lastRowInUse) 
   On Error Resume Next 
   Err.Clear 
   Set copyRange = Range(copyRangeAddress) 
    
   If Err.Number <> 0 Then 
      MsgBox "Error occured while checking range '" & copyRange & " '. " & Err.Description 
      Exit Sub 
   End If 
   On Error GoTo 0 
   With copyRange 
      Set firstCellToCopy = Range(.Cells(1, 1).Address) 
      Set lastCellToCopy = Range(.Cells(.Rows.Count, .Columns.Count).Address) 
   End With 
    
   lastRowInUse = getItemLocation("*", Range(Cells(1, firstCellToCopy.Column), Cells(Rows.Count, lastCellToCopy.Column))) 
   lastRowForCopy = lastCellToCopy.Row 
   If (lastRowForCopy > lastRowInUse) Then lastRowInUse = lastRowForCopy 
   rowsAvailable = Rows.Count - lastRowInUse 
   If (rowsAvailable < copyRange.Rows.Count) Then 
      MsgBox "Not enough rows available to copy the range '" & copyRange & " '. " 
      Exit Sub 
   End If 
   maxCopy = (rowsAvailable - (rowsAvailable Mod copyRange.Rows.Count)) / copyRange.Rows.Count 
    
   numberOfCopies = InputBox("Enter number of times range " + copyRangeAddress + " is to be copied. ", "Number of times", maxCopy) 
   If (maxCopy < numberOfCopies) Then 
      MsgBox "Not enough rows available to copy the range '" & copyRangeAddress & " ' " & numberOfCopies & " number of times" 
      Exit Sub 
   End If 
   Application.CutCopyMode = False 
   copyRange.Copy 
   For copyCounter = 1 To numberOfCopies 
      Cells(lastRowInUse + 1, lastCellToCopy.Column).PasteSpecial 
      lastRowInUse = lastRowInUse + copyRange.Rows.Count 
   Next 
   Application.CutCopyMode = False 
    
End Sub 

Public Function getItemLocation(sLookFor As String, _ 
                                rngSearch As Range, _ 
                                Optional bFullString As Boolean = True, _ 
                                Optional bLastOccurance As Boolean = True, _ 
                                Optional bFindRow As Boolean = True) As Long 
                                    
   'find the first/last row/column  within a range for a specific string 
       
   Dim Cell             As Range 
   Dim iLookAt          As Integer 
   Dim iSearchDir       As Integer 
   Dim iSearchOdr       As Integer 
          
   If (bFullString) _ 
   Then 
      iLookAt = xlWhole 
   Else 
      iLookAt = xlPart 
   End If 
   If (bLastOccurance) _ 
   Then 
      iSearchDir = xlPrevious 
   Else 
      iSearchDir = xlNext 
   End If 
   If Not (bFindRow) _ 
   Then 
      iSearchOdr = xlByColumns 
   Else 
      iSearchOdr = xlByRows 
   End If 
          
   With rngSearch 
      If (bLastOccurance) _ 
      Then 
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir) 
      Else 
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir) 
      End If 
   End With 
          
   If Cell Is Nothing Then 
      getItemLocation = 0 
   ElseIf Not (bFindRow) _ 
   Then 
      getItemLocation = Cell.Column 
   Else 
      getItemLocation = Cell.Row 
   End If 
   Set Cell = Nothing 

End Function 


>
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020

can I copy the same data on sheet2 by using the same macro