Come promesso ecco la versione definitiva (ma nn troppo
). Grazie ai consigli di Anthony ho prodotto questo, le celle da importare da ogni singolo questionario sono più di 500, e quindi nn ci stanno su una sola riga. Visto che per ragioni pratiche mettere le risposte in colonna non risultava molto utile per andare poi a fare delle analisi, ho deciso di registrare i dati registrando dei "blocchi" di celle, selezionate tramite range, in quanto sono dati relativi ad un singolo fornitore, e impilandoli andrò poi a vedere i dati di tutti i fornitori. Inoltre i dati non sono più registrati su un unico foglio, ma su più fogli diversi, fermo restando "Foglio2" come foglio di appoggio per tutti. In questo modo, ad ogni sezione del questionario faccio corrispondere un foglio di registrazione.
A tal proposito volevo domandare ad Anthony 2 cose:
1)perchè la macro funziona correttamente solo dopo alcune attivazioni?da cosa dipende questo fatto? nelle prime attivazioni ha delle difficoltà a fare il cambio di link e quindi tende a ripetere i dati
2)è possibile, a fine registrazione spostare il file registrato dalla cartella Risposte questionari ad un' altra dove andrò a mettere i file già registrati al fine di evitare di registrare nuovamente il file?
Ecco per ora la macro:
Sub registra2()
SourceDir = "C:\Documents and Settings\xxx \Desktop\Risposte questionari"
Set fs = Application.FileSearch
With fs
.LookIn = SourceDir
.SearchSubFolders = False
.Filename = "*.xls" 'MMMMMMMMMMM
If .Execute() = 0 Then
MsgBox "No files in " & SourceDir
Exit Sub
End If
End With
'fine primo riferimento
With fs
MsgBox ("il numero di files nella cartella è: " & fs.FoundFiles.Count)
For i = 1 To fs.FoundFiles.Count 'MMMMMMMMMMMMMM
'2 qual è il link attuale
Matrlinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If IsEmpty(Matrlinks) Then GoTo Esci
'MsgBox (MatrLinks(1))
Fullnome = fs.FoundFiles(i) 'MMMMMMMMMMM
Mess = "Vuoi registrare il file" & Fullnome & vbCrLf & "? SI per confermare, NO per saltare questo file, CANCEL per annullare"
scelta = MsgBox(Prompt:=Mess, Buttons:=vbYesNoCancel)
If scelta = 2 Then GoTo Esci
If scelta = 7 Then GoTo Salta
'inserimento di una informazione aggiuntiva che andrà poi copiata nel foglio2
Mess = "Digita il codice del cliente per il file " & Fullnome & vbCrLf
codice = Application.InputBox(Prompt:=Mess, Title:="CODICE CLIENTE")
' 2b - Segnala Link corrente e nuovo e scelta Azione
'3 - Cambia il link
ActiveWorkbook.ChangeLink Name:=Matrlinks(1), NewName:= _
Fullnome, Type:= _
xlExcelLinks
Sheets("Foglio2").Select
Range("A13:G15").Copy
Sheets("Foglio1").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
‘prima selezione di foglio2 da copiare
Sheets("Foglio2").Select
Range("A19:G21").Copy
Sheets("Foglio3").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
‘seconda selezione di foglio2 da copiare
Sheets("Foglio2").Select
Range("A6:I9").Copy
Sheets("Foglio4").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
‘copia di riga2
Sheets("Foglio2").Select
Range("A2").Select
ActiveCell.Value = codice
Range("2:2").Copy
Sheets("Foglio5").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Foglio2").Select
Range("A24:D44").Copy
Sheets("Foglio6").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Salta:
Next i
Sheets("Anagrafica-Produzione-Qualità").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
MsgBox ("IL NUMERO TOTALE DI QUESTIONARI REGISTRATI FINORA E': " & ActiveCell.Row - 2)
‘ -2 perché avrò una riga con le intestazioni e inoltre la cella selezionata è nella riga sotto l’ultimo questionario inserito
Esci:
End With
End Sub
Grazie di nuovo ad Anthony per l'aiuto!