Una macro da rendere più fruibile

[papiriof]

Più di tante parole di seguito metto la macro da cambiare con le note dei desiderata:
Sub ApplicaRuotaGioco()
'
' ApplicaRuotaGioco Macro
'

'"D:H" =BARI
'"I:M" cagliari
'"N:R" firenze
'"S:W"
'"X:AB"
'"AC:AG"
'"AH:AL"
'"AM:AQ"
'"AR:AV"
'"AW:BA"
'"BB:BF"
Sheets("Archivio").Select
Columns("D:H").Select ' <------Qui ho messo da selezionare e copiare le colonne ("D:H") che rappresentano
Selection.Copy ' la ruota di BARI che vengono incollate in 5 successivi fogli
Sheets("ESTRdet1").Select ' La Macro funziona bene ma quando voglio cambiare la ruota devo entrare nella
Range("D1").Select ' macro stessa e al posto "D:H" di mettere una di quelle remmate all'nizio che rappresentano
ActiveSheet.Paste ' le altre 10 ruote compresa la Nazionale
Sheets("ESTRdet2").Select 'Come fare in modo che la macro mi chieda quale ruota vovio selezionaree copiare?
Range("D1").Select 'Avevo pensato ad un inputbox ma non l'ho saputo incastonare
ActiveSheet.Paste
Sheets("ESTRdet3").Select
Range("D1").Select
ActiveSheet.Paste
Sheets("ESTRdet4").Select
Range("D1").Select
ActiveSheet.Paste
Sheets("ESTRdet5").Select
Range("D1").Select
ActiveSheet.Paste
Sheets("Foglio1").Select
Range("A1").Select
End Sub

[Marius44]

Ciao
Penso che l'INPUTBOX vada inserita in mezzo a queste due righe di codice

Codice: Seleziona tutto

Sheets("Archivio").Select
' <<< qui l'InputBox che in uscita ti dà la stringa da passare a Columns
Columns("stringa").Select

Ciao,
Mario

[papiriof]

Ho fatto così (per come ho capito):
Sub ApplicaRuotaGioco()
'
' ApplicaRuotaGioco Macro
'

'"D:H" =BARI
'"I:M" cagliari
'"N:R" firenze
'"S:W"
'"X:AB"
'"AC:AG"
'"AH:AL"
'"AM:AQ"
'"AR:AV"
'"AW:BA"
'"BB:BF"
Sheets("Archivio").Select
Dim stringa As String 'aggiunto
stringa = InputBox(stringa) ' aggiunto come suggerito
Columns("stringa").Select ' modificato come sugerito '
Selection.Copy
Sheets("ESTRdet1").Select

ecc come sopra
ebbene faccio girare mi porta giustamente al foglio Archivio (con la visione dello steso)con l'imputbox pronto a ricevere la stringa a questo punto digito D:H quindi ok e mi da errorre run time 13 tipo non corrispondente si ferma a questa istruzione " Columns("stringa").Select "

[Anthony47]

Ho fatto così (per come ho capito)

Codice: Seleziona tutto

Dim stringa As String 'aggiunto
stringa = InputBox(stringa) ' aggiunto come suggerito
Columns("stringa").Select ' modificato come sugerito '
Selection.Copy

Devi usare il contenuto della variabile stringa, non quella stringa:

Codice: Seleziona tutto

Dim stringa As String 'aggiunto
stringa = InputBox(stringa) ' aggiunto come suggerito
Columns(stringa).Select ' modificato come sugerito  <<<
Selection.Copy


Un'altra opzione:

Codice: Seleziona tutto

Sub ApplicaRuotaGioco()
Dim rArr, myMatch, Rispo
'
' ApplicaRuotaGioco Macro
'
rArr = Array("Bari", "D:H", "Cagliari", "I:M", etc1, etc2, etc1, etc2)  '<<< Tutte le ruote e relative colonne
Rispo = Application.InputBox(prompt:="Dimmi la ruota", Type:=2)
'
myMatch = Application.Match(Rispo, rArr, False)
'
If Not IsError(myMatch) Then
    Sheets("Archivio").Select
    Columns(rArr(myMatch)).Copy
    Sheets("ESTRdet1").Select
    Range("D1").Select
    ActiveSheet.Paste
    Sheets("ESTRdet2").Select
    Range("D1").Select
    ActiveSheet.Paste
    Sheets("ESTRdet3").Select
    Range("D1").Select
    ActiveSheet.Paste
    Sheets("ESTRdet4").Select
    Range("D1").Select
    ActiveSheet.Paste
    Sheets("ESTRdet5").Select
    Range("D1").Select
    ActiveSheet.Paste
Else
    MsgBox ("Risposta invalida")
End If
Application.CutCopyMode = False
End Sub


La riga marcata <<< va completata con tutte le definizioni necessarie

Avrebbe certamente aiutato sapere le nel foglio Archivio le estrazioni hanno una intestazione che possono aiutare a scegliere quel che si vuole; e se si vuole proprio una copia o basta la copia valori.
Visto che non si sa ho proceduto come da impostazione attuale con l'aggiunta di un inputbox.

Ciao

[papiriof]

Per poco non capivo le virgolette non le riuscivo a notare
Grazie ( in ordine di apparizione) a Marius44 e Anthony