Macro Excel conta righe e dividi

[mpontic]

Ciao a tutti, vi chiedo se si puo' impostare una macro che mi conti le righe presenti in un foglio di lavoro, le divida per 3 e copi i tre pacchetti in un file di appoggio. Grazie mille
marco

[Flash30005]

Ciao Mpontic e benvenuto nel Forum

Prova questa macro, nomina il foglio dei dati origine "Dati" oppure modifica opportunamente quel nome nella macro adattandolo al nome del tuo foglio (in Worksheets)

Codice: Seleziona tutto

Sub CopiaRighe()
Dim Percorso As String
Dim NomeFile As String
FileDati = ThisWorkbook.Name
Percorso = "C:\Data\"
NomeFile = "Mio.xls"
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Percorso & NomeFile
Windows(FileDati).Activate
UR = Worksheets("Dati").Range("A" & Rows.Count).End(xlUp).Row
DivR = Int(UR / 3)
If UR Mod 3 <> 0 Then DivR = Int(UR / 3) + 1
Ini = 1
For DR = 1 To 3
VDR = DR - 1
    Worksheets("Dati").Rows(Ini + VDR * DivR & ":" & DivR * DR).Copy Destination:=Workbooks("Mio.xls").Worksheets("Foglio" & DR).Range("A1")
Next DR
Windows(NomeFile).Activate
ActiveWorkbook.Close SaveChanges:=True
End Sub


Il file, con questa macro, si chiamerà Mio.xls e sarà salvato nella directory C:\Data
(la directory Data dovrai crearla se vuoi testare la macro)
inserisci il percorso che riterrai opportuno settando queste variabili a tuo piacimento
Percorso = "C:\Data\"
NomeFile = "Mio.xls"
e avrai il tuo file con le righe separate per ogni foglio (valido per 3 fogli come da tua richiesta, nel caso interveniamo)


Fai sapere
Ciao

[mpontic]

ciao a tutti

mi hanno chiesto di fare lo stesso lavoro per il quale mi avete brillantemente aiutato ma questa volta dividendo le righe totali per 4 e copiando su 4 sheet.
Ho provato banalmente a modificare il precedente codice sostituendo il 3 con il 4 ma mi da' debug.
Aiutatemi per piacere...sto impazzendo

grazie mille

[Flash30005]

La macro precedente andava in errore in quanto superavi il numero dei fogli esistenti in una nuova cartella

Ho adattato la macro affinché tu possa modificare, secondo la tua esigenza, il valore della variabile NDiv (divisore)
saranno creati tutti i fogli necessari per incollare le righe copiate

[code]Sub DivRigheECopia()
Dim Percorso As String
Dim NomeFile As String
FileDati = ThisWorkbook.Name
Percorso = "C:\Data\" '<<<<<< percorso di outputo del file
NomeFile = "Mio2.xls" '<<<< nome del file di output
Ndiv = 4 '<<<<< cambiare questo valore in funzione delle parti divisori
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Percorso & NomeFile
NFI = ActiveWorkbook.Sheets.Count
If NFI < Ndiv Then
For NF = 1 To Ndiv - NFI
Worksheets.Add After:=Sheets(Sheets.Count)
Next NF
End If
Windows(FileDati).Activate
UR = Worksheets("Dati").Range("A" & Rows.Count).End(xlUp).Row
DivR = Int(UR / Ndiv)
If UR Mod Ndiv <> 0 Then DivR = Int(UR / Ndiv) + 1
Ini = 1
For DR = 1 To Ndiv
VDR = DR - 1
Worksheets("Dati").Rows(Ini + VDR * DivR & ":" & DivR * DR).Copy Destination:=Workbooks("Mio2.xls").Worksheets("Foglio" & DR).Range("A1")
Next DR
Windows(NomeFile).Activate
ActiveWorkbook.Close SaveChanges:=True
End Sub
[/code

Fai sapere
Ciao