Copy Paste Data in Same column for multiple time [Solved/Closed]

sudeep.leadtech 3 Posts Saturday December 15, 2012Registration date December 18, 2012 Last seen - Dec 15, 2012 at 01:24 PM - Latest reply:  sree
- Jan 21, 2015 at 04:21 AM
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

See more 

5 replies

Best answer
rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Dec 16, 2012 at 09:15 AM
9
Thank you
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?

Thank you, rizvisa1 9

Something to say? Add comment

CCM has helped 1793 users this month

sudeep.leadtech 3 Posts Saturday December 15, 2012Registration date December 18, 2012 Last seen - Dec 17, 2012 at 12:39 AM
5
Thank you
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,
sudeep.leadtech 3 Posts Saturday December 15, 2012Registration date December 18, 2012 Last seen - Dec 18, 2012 at 12:45 AM
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
rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Dec 18, 2012 at 06:33 AM
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 


sree > rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Jan 21, 2015 at 04:21 AM
can I copy the same data on sheet2 by using the same macro