Copy Paste Data in Same column for multiple time

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