Public Sub copia()
    

On Error GoTo RigaErrore

    
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim lUltRiga1 As Long
    Dim lUltRiga2 As Long
    Dim lng1 As Long
    Dim lng2 As Long
    Dim valore As Long
    
    
    
    With Application
        .ScreenUpdating = False
        .CutCopyMode = False
    End With
    
    
    Set sh1 = Worksheets("Foglio1")
    Set sh2 = Worksheets("Foglio2")
    
    With sh1
        
        lUltRiga1 = .Range("A" & _
            .Rows.Count).End( _
            xlUp).Row
       
        lUltRiga2 = sh2.Range("A" & _
            .Rows.Count).End( _
            xlUp).Row
       
        sh2.Range("A2:D" & lUltRiga2).Value = ""
        lUltRiga2 = 2
        
        For lng1 = 2 To lUltRiga1
        testo = .Range("A" & lng1)
           
            valore = Application.InputBox("quante volte vuoi copiare " & testo)
            For lng2 = 1 To valore
                
                .Range("A" & lng1 & ":C" & lng1).Copy _
                    Destination:=sh2.Range( _
                    "A" & lUltRiga2)
                lUltRiga2 = lUltRiga2 + 1
            Next
        Next
    End With
    

RigaChiusura:
    
    With Application
        .ScreenUpdating = True
        .CutCopyMode = True
    End With
    
    Set sh2 = Nothing
    Set sh1 = Nothing
    Exit Sub


RigaErrore:
    MsgBox Err.Number & vbNewLine & Err.Description
    Resume RigaChiusura
    
End Sub