Macro Copy & Paste: Numeric to Alphanumeric

[Momo81]

Hi, this macro works if a number is entered (1,2,10... ect). Can you change it so that an alphanumeric code (AB2, PF3, CP10...) is entered?

Sub CopiaEsercizio1()
    Dim j As Long, uR As Long, uR2 As Long
    Dim numero, bln As Boolean
    numero = InputBox("Scrivi il numero dell'esercizio da copiare")
    With Sheets("Database")
        uR = .Cells(Rows.Count, 1).End(xlUp).Row
        uR2 = Sheets("Allenamento").Cells(Rows.Count, 1).End(xlUp).Row + 10
        For j = 5 To uR Step 10
            If .Cells(j, 1) = Val(numero) Then
                If Sheets("Allenamento").Cells(1, 1) = "" Then uR2 = 19
                .Range("A" & j + 0 & ":AO" & j + 9).Copy Sheets("Allenamento").Cells(uR2, "A")
                Sheets("Allenamento").Cells(uR2, 1) = numero
                bln = True
                Exit For
            End If
        Next j
    End With
    messaggio1 = "Fatto!"
    messaggio2 = "Il numero scelto non corrisponde a nessun esercizio!"
    MsgBox IIf(bln = True, messaggio1, messaggio2)
End Sub 

[paulked]

Hi and welcome to the forum.

I can't test this, but try it after changing the text in red:

Sub CopiaEsercizio1() 
    Dim j As Long, uR As Long, uR2 As Long 
    Dim numero, bln As Boolean 
    numero = InputBox("Scrivi il numero dell'esercizio da copiare") 
    With Sheets("Database") 
        uR = .Cells(Rows.Count, 1).End(xlUp).Row 
        uR2 = Sheets("Allenamento").Cells(Rows.Count, 1).End(xlUp).Row + 10 
        For j = 5 To uR Step 10 
            If .Cells(j, 1) = numero Then ' was Val(numero)                If Sheets("Allenamento").Cells(1, 1) = "" Then uR2 = 19 
                .Range("A" & j + 0 & ":AO" & j + 9).Copy Sheets("Allenamento").Cells(uR2, "A") 
                Sheets("Allenamento").Cells(uR2, 1) = numero 
                bln = True 
                Exit For 
            End If 
        Next j 
    End With 
    messaggio1 = "Fatto!" 
    messaggio2 = "Il numero scelto non corrisponde a nessun esercizio!" 
    MsgBox IIf(bln = True, messaggio1, messaggio2) 
End Sub

[Momo81]

It Works! Thank you

Hi and welcome to the forum.

I can't test this, but try it after changing the text in red:

Sub CopiaEsercizio1() 
    Dim j As Long, uR As Long, uR2 As Long 
    Dim numero, bln As Boolean 
    numero = InputBox("Scrivi il numero dell'esercizio da copiare") 
    With Sheets("Database") 
        uR = .Cells(Rows.Count, 1).End(xlUp).Row 
        uR2 = Sheets("Allenamento").Cells(Rows.Count, 1).End(xlUp).Row + 10 
        For j = 5 To uR Step 10 
            If .Cells(j, 1) = numero Then ' was Val(numero)                If Sheets("Allenamento").Cells(1, 1) = "" Then uR2 = 19 
                .Range("A" & j + 0 & ":AO" & j + 9).Copy Sheets("Allenamento").Cells(uR2, "A") 
                Sheets("Allenamento").Cells(uR2, 1) = numero 
                bln = True 
                Exit For 
            End If 
        Next j 
    End With 
    messaggio1 = "Fatto!" 
    messaggio2 = "Il numero scelto non corrisponde a nessun esercizio!" 
    MsgBox IIf(bln = True, messaggio1, messaggio2) 
End Sub

[paulked]

You're welcome, please mark it solved (Thread Tools on the tool bar at the top of the page)