Ciao,
avevo già fatto la premessa sulla soluzione chiavi in mano e, con quanto hai scritto, come soluzione vedo solo quella di fornirti una macro sulla quale lavorare ed analizzare le funzioni che realizza, ti commento qualcosa direttamente nella macro.
Passi da fare:
1. aprire un nuovo file xls
2. copiare i tuoi dati nel foglio1
3. aprire l'editor del VB con "Alt+F11"
4. posizionarsi su VBAProject
5. tasto destro, inserisci, modulo
6. nel Modulo appena inserito copiare la macro
7. con “F5” esegui tutta la macro, con “F8” esegui la macro istruzione per istruzione
8. puoi associare la macro ad un “Pulsante”
o
ad una combinazione di tasti Ctrl+Shift+ “Scegli un tasto”
- Codice: Seleziona tutto
Option Explicit
Public RR As Integer, I As Integer, J As Integer, Sh As Worksheet, Nome_Foglio As String
Sub Elabora_Dati_su_più_Fogli()
' ATTENZIONE: la macro cancella tutti i fogli presenti nel file XLS Attivo
' I dati sono nel "Foglio1"
' e partono dalla riga "2" colonne "A" e "B"
Application.ScreenUpdating = False
' Vengono cancellati tutti i fogli presenti nel file tranne "Foglio1"
Application.DisplayAlerts = False
For Each Sh In Worksheets
If UCase(Sh.Name) <> "FOGLIO1" Then
Sh.Delete
I = I + 1
End If
Next Sh
Application.DisplayAlerts = True
Foglio1.Select
' Ordinamento dei dati per colonna "B" e poi per colonna "A" (Ascendente)
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
' Elabora i dati e crea un nuovo foglio con il nome delle celle in colonna "B"
RR = Range("A" & Rows.Count).End(xlUp).Row
Nome_Foglio = ""
J = 2
For I = 2 To RR
If Foglio1.Cells(I, 2) <> Nome_Foglio Then
Sheets.Add
Sheets(1).Name = Foglio1.Cells(I, 2)
Nome_Foglio = Foglio1.Cells(I, 2)
Sheets(Nome_Foglio).Cells(1, 1) = Foglio1.Cells(1, 1)
J = 2
End If
Sheets(Nome_Foglio).Cells(J, 1) = Foglio1.Cells(I, 1)
J = J + 1
Next I
[A1].Select
Application.ScreenUpdating = False
MsgBox "Elaborazione Effettuata: '" & J & "' fogli inseriti"
End Sub
PROVA e ….
Ovviamente andrà adattata e personalizzata in base alle effettive e globali esigenze di tutto il tuo progetto.
Quello che ti occorre non penso sai solo quello che hai scritto ed i dati saranno anche in altre colonne … ma questo poi sarà tuo … compito e tuo … divertimento intervenire.
Ciao da Ricky53