Macro per filtro dati e salvataggio file con nome (excel 2010)

Question

Buonasera a tutti, ho bisogno di un cortese aiuto per risolvere un problema relativo ad un file di excel.

Il problema è questo: ho una tabella dati composta da questi campi: Codice - Nome - Cognome

Il campo Codice è un valore numerico (min 1 max 32 ma non consecutivo es.: 1 3 7 11).

Avrei bisogno di scrivere una macro che mi filtri la tabella dati in base al codice e, per ogni codice, mi salvi in dati in una nuova cartella di lavoro il cui nome del file deve essere uguale a "Cartella" + Codice filtrato (es "cartella 1.xls" contenente tutti i record con codice 1, "Cartella 3.xls" contenente tutti i record con codice 3 ecc. ecc.).

Premetto che sono un autodidatta in VBA e nonostante i miei sforzi non sono riuscito a venire a capo di nulla.

Potreste darmi un aiuto ?

Vi ringrazio anticipatamente

Giovanni

Answer 1

Avrei bisogno di scrivere una macro che mi filtri la tabella dati in base al codice e, per ogni codice, mi salvi in dati in una nuova cartella di lavoro il cui nome del file deve essere uguale a "Cartella" + Codice filtrato (es "cartella 1.xls" contenente tutti i record con codice 1, "Cartella 3.xls" contenente tutti i record con codice 3 ecc. ecc.).

Ne abbiamo discusso (abbondantemente) qui:

• http://answers.microsoft.com/it-it/office/forum/office_2010-excel/suddivisione-foglio-excel/982ca7d5-ea03-4649-86d3-9f271a80872a

Answer 2

Ora ho risolto.

Grazie a tutti per l'aiuto e per la pazienza.

Giovanni

Answer 3

Grazie per l'aiuto, la macro funziona.

Mi permetto di chiedere un altro aiuto: cosa devo modificare per aggiungere anche la colonna "A" e le eventuali colonne dalla D in avanti  nei singoli file?

Ringrazio anticipatamente per la vostra risposta.

Giovanni

Ripeto prova a leggere il post che ho linkato prima, anche la parte dove si chiede se, per favore, quando si posta una domanda la si posta completa. Grazie.

Answer 4

Grazie per l'aiuto, la macro funziona.

Mi permetto di chiedere un altro aiuto: cosa devo modificare per aggiungere anche la colonna "A" e le eventuali colonne dalla D in avanti  nei singoli file?

Ringrazio anticipatamente per la vostra risposta.

Giovanni

Answer 5

Buonasera a tutti, ho bisogno di un cortese aiuto per risolvere un problema relativo ad un file di excel.

Il problema è questo: ho una tabella dati composta da questi campi: Codice - Nome - Cognome

Il campo Codice è un valore numerico (min 1 max 32 ma non consecutivo es.: 1 3 7 11).

Avrei bisogno di scrivere una macro che mi filtri la tabella dati in base al codice e, per ogni codice, mi salvi in dati in una nuova cartella di lavoro il cui nome del file deve essere uguale a "Cartella" + Codice filtrato (es "cartella 1.xls" contenente tutti i record con codice 1, "Cartella 3.xls" contenente tutti i record con codice 3 ecc. ecc.).

Premetto che sono un autodidatta in VBA e nonostante i miei sforzi non sono riuscito a venire a capo di nulla.

Potreste darmi un aiuto ?

Vi ringrazio anticipatamente

Giovanni

Ciao Giovanni,

Alt-F11 per aprire l'editor di VBA

Alt-IM per inserire un nuovo modulo di codice

Nel nuovo modulo vuoto, incolla il seguente codice:

'==========>>

Option Explicit

'---------->>

Public Sub Tester()

Dim WB As Workbook

Dim newWB As Workbook

Dim SH As Worksheet

Dim Rng As Range

Dim arrIn As Variant

Dim arrOut() As Variant

Dim arrHeaders As Variant

Dim i As Long, j As Long, k As Long, m As Long

Dim iLastRow As Long

Const sStr As String = "Cartella"

Const iMax As Long = 32

On Error GoTo ErrHandler

Application.ScreenUpdating = False

Set WB = Workbooks("Pippo.xlsx")               '<<=== Cambia

Set SH = WB.Sheets("Foglio1")                     '<<=== Cambia

With SH

iLastRow = .Cells(Rows.Count, "A").End(xlUp).Row

Set Rng = .Range("A2:C" & iLastRow)

arrHeaders = .Range("B1:C1").Value

End With

arrIn = Rng.Value

For i = 1 To iMax

For j = 1 To UBound(arrIn, 1)

If arrIn(j, 1) = i Then

k = k + 1

ReDim Preserve arrOut(1 To 2, 1 To k)

For m = 1 To 2

arrOut(m, k) = arrIn(j, m + 1)

Next m

End If

Next j

If k > 0 Then

Set newWB = Workbooks.Add

With newWB

With .Sheets(1)

.Range("A1:B1").Value = arrHeaders

.Range("A2:B2").Resize(k, 2).Value = Application.Transpose(arrOut)

End With

.SaveAs Filename:=sStr & i & ".xlsx", FileFormat:= xlOpenXMLWorkbook

.Close SaveChanges:=False

End With

End If

k = 0

Next i

XIT:

Application.ScreenUpdating = True

On Error GoTo 0

Exit Sub

ErrHandler:

Call MsgBox(Prompt:="Error " _

& Err.Number _

& " (" _

& Err.Description _

& ") nella routine: Tester", _

Buttons:=vbCritical, _

Title:="ERRORE")

Resume XIT

End Sub

'<<==========

Alt-Q per chiudere l'editor di VBA

Alt-F8 per aprire la finestrina macro

Seleziona Tester | Esegui

===

Regards,

Norman