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) :thumb