Copy data multiple time below each other based on condition

[Mindrage]

Dear All,

Need some assistance in creating a macro. I have a number count in tab 2 in one cell and based on which i need to have data in 2 cell (same sheet) copied that many time in sheet one below each other in same column. Expample : If i have a count of 5, i need data in 2 cells to be copied 5 times below each other in sheet one.

 

[saltkev]

Hi

Give this a go, hope I have understood Your Requirements. Can Be put under a command button.

Private Sub CommandButton1_Click()

Static Counter
Counter = 0
While Counter < Range("a1").Value  'Cell holding number of copies
   ' Counter = Counter + 1
    
    Range("b3:c3").Copy  'Range to be copied
    
  
    
    If Range("b4").Value = "" Then  ' range to where to start copy
    
    Range("b4").PasteSpecial
    
       Counter = Counter + 1
       
    End If
    
    
    
        If Range("b4").Value > "" And Range("b5") = "" Then
    
        Range("b5").PasteSpecial
        Counter = Counter + 1
        End If
        
    
    
             If Range("b4").Value > "" And Range("b5") > "" Then
    
                Range("b4").Select
                Selection.End(xlDown).Select
                Selection.Offset(1, 0).PasteSpecial
              Counter = Counter + 1
             End If
             
Wend
 
End Sub

regards

Kev

 

[saltkev]

Hi

Amendment to previous post, it does not work for values < 3. This sorts it, but is a little messy, there is probably a tidier way.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

Application.ScreenUpdating = False
Static Counter
Counter = 0
Range("b4:c18").Clear

                If Range("a1").Value = 1 Then
                    Range("k1:l1").Copy  'Range to be copied
                        Range("b4").PasteSpecial
                            Exit Sub
                End If
                        If Range("a1").Value = 2 Then
                            Range("k1:l1").Copy  'Range to be copied
                            Range("b4:b5").PasteSpecial
                                Exit Sub
                        End If
 
While Counter < Range("a1").Value  'Cell holding number of copies
   ' Counter = Counter + 1
    
    Range("k1:l1").Copy  'Range to be copied
    
  
    
    If Range("b4").Value = "" Then  ' range to where to start copy
    
    Range("b4").PasteSpecial
    
       Counter = Counter + 1
       
    End If
    
    
    
        If Range("b4").Value > "" And Range("b5") = "" Then
    
        Range("b5").PasteSpecial
        Counter = Counter + 1
        End If
        
    
    
             If Range("b4").Value > "" And Range("b5") > "" Then
    
                Range("b4").Select
                Selection.End(xlDown).Select
                Selection.Offset(1, 0).PasteSpecial
              Counter = Counter + 1
             End If
             
Wend
 
End Sub

regards