Dividere foglio in piu' fogli e concatena

[marcopont]

Buonasera a tutti

vi chiedo un aiuto per risolvere una mia difficolta'.
Partendo da un foglio dove in colonna A ho xmila numeri, avrei bisogno di dividere questo listone in fogli contenenti 1000 record ognuno (fino ad esaurimento lista) e che alla fine mi riporti anche in cella C1 di ciascun foglio, la concatenazione delle 1000 celle con i valori separati da virgola (xxxxx, yyyyy, zzzzz.....)

mi aiutate per piacere?
grazie in ogni caso per l'attenzione

Marco

[Anthony47]

Quale e' il layout dei dati di partenza? Probabilmente basta una immagine, ma se condividi un file già popolato con dati è molto meglio.
Il "Concatenamento" deve riguardare tutte le colonne dei singoli record?
E poi, quale e' la tua versione di Office?

[marcopont]

ciao Anthony

non posso condividere il file perche' contiene dati sensibili.
Il file e' popolato solo in colonna A con (tipo) 5500 numeri di telefono
Il concatenamento quindi deve riguardare le 1000 celle che saranno popolate in ognuno dei 6 fogli generati (1000+1000+1000+1000+1000+500). Quindi nel Foglio2 con le prime 1000 celle presenti in colonna A, vorrei in cella C1 il concatena delle 1000 celle.
Excel Microsoft 365

grazie
Marco

[Anthony47]

Prova con questa macro:

Codice: Seleziona tutto

Sub AMille()
Dim cShN As Long, fStep As Long, iPos As Range
Dim I As Long, stCnt As Long
'
Set iPos = Sheets("IDati").Range("A1")      '<<< Inizio dei dati da splittare
fStep = 1000                                '<<< Quante righe per ogni foglio
'
cShN = Sheets.Count
Application.Goto iPos
For I = 1 To iPos.Offset(100000, 0).End(xlUp).Row Step fStep
    Sheets.Add after:=Sheets(cShN + stCnt)
    iPos.Offset(stCnt * fStep).Resize(fStep, 1).Copy Destination:=Sheets(cShN + stCnt + 1).Range("A1")
    stCnt = stCnt + 1
    Range("C1").Value = Evaluate("TEXTJOIN("", "",TRUE,A1:A" & fStep + 10 & ")")
Next I
Application.CutCopyMode = False
MsgBox ("Completato, " & stCnt & " nuovi fogli")
End Sub


Le due righe marcate <<< vanno personalizzate con le tue informazioni

Quando nel foglio di partenza hai i dati che vuoi splittare, basterà avviare la Sub Amille. A questo punto:
-per ogni blocco di 1000 righe (o quanto impostato in fStep) verrà aggiunto un nuovo foglio
-ogni blocco verrà incollato a partire da A1
-in C1 sarà calcolato il concatenamento dei dati presenti su colonna A

Prova e fai sapere...

[marcopont]

Grazie Anthony
la divisione in fogli e' perfetta, ma per il concatena probabilmente non ho spiegato bene.
Il concatena deve essere su ognuno dei nuovi fogli creati con i 1000 record, mentre ora e' sul foglio di partenza (con i 5500 pezzi).
Inoltre (questo non lo avevo scritto), il concatena deve contenere i testi tra apici ( ' )

grazie ancora

[Anthony47]

No, la macro dovrebbe scrivere in C1 di ognuno dei fogli aggiunti; provato in Office 365
Se a te si comporta diversamente prova a sostituire le righe stCnt = stCnt + 1 / Range("C1").Value = etc etc con

Codice: Seleziona tutto

'    stCnt = stCnt + 1
    Sheets(cShN + stCnt + 1).Range("C1").Value = "''" & Evaluate("TEXTJOIN(""', '"",TRUE,A1:A" & fStep + 10 & ")") & "'"
    stCnt = stCnt + 1

che contiene anche le modifiche per inserire gli "apici"

[marcopont]

non va (((((
Errore runtime 13
Tipo non corrispondente

[Anthony47]

A: la macro va messa in un "Modulo standard" del vba, non in un "modulo di classe" appartenente al workbook o a un foglio. Vedi viewtopic.php?f=26&t=103893&p=647675#p647675
B: "tipo non corrispondente" su quale istruzione?

[marcopont]

A: Risolto

B: errore sulla istruzione
Sheets(cShN + stCnt + 1).Range("C1").Value = "''" & Evaluate("TEXTJOIN(""', '"",TRUE,A1:A" & fStep + 10 & ")") & "'"

(quella modificata per gli apici in pratica)

[Anthony47]

Puoi pubblicare il codice completo che stai usando? Copia dal tui vba, incolla nel tuo messaggio

[marcopont]

Codice: Seleziona tutto

Sub AMille()
Dim cShN As Long, fStep As Long, iPos As Range
Dim I As Long, stCnt As Long
'
Set iPos = Sheets("Foglio1").Range("A1")      '<<< Inizio dei dati da splittare
fStep = 1000                                '<<< Quante righe per ogni foglio
'
cShN = Sheets.Count
Application.Goto iPos
For I = 1 To iPos.Offset(100000, 0).End(xlUp).Row Step fStep
    Sheets.Add after:=Sheets(cShN + stCnt)
    iPos.Offset(stCnt * fStep).Resize(fStep, 1).Copy Destination:=Sheets(cShN + stCnt + 1).Range("A1")
' stCnt = stCnt + 1
  '  Range("C1").Value = Evaluate("TEXTJOIN("", "",TRUE,A1:A" & fStep + 10 & ")")
   
    Sheets(cShN + stCnt + 1).Range("C1").Value = "'" & Evaluate("TEXTJOIN(""', '"",TRUE,A1:A" & fStep + 10 & ")") & "'"
    stCnt = stCnt + 1
   
   
Next I
Application.CutCopyMode = False
MsgBox ("Completato, " & stCnt & " nuovi fogli")
End Sub

[Anthony47]

Quarda il contenuto della colonna A del foglio attivo al momento dell'errore; credo ci siano delle celle in errore o comunque qualcosa di anomalo

Comunque sostituisci la riga che va in errore con quest'altra:

Codice: Seleziona tutto

    Range("C1").Formula = "=""'""&TEXTJOIN("", '"",TRUE,A1:A" & fStep + 10 & ")&""'"""

In questo modo in C1 metterai la formula che genera il risultato: in caso di anomalia sui dati in partenza avrai un errore in C1 non nella macro

[marcopont]

Ora e' quasi ok...ma mette apice solo prima del numero (es: '338xxxxxxxxx, '338yyyyyyy, )

[Anthony47]

E' perchè qualcuno ha sbagliato la formula

Codice: Seleziona tutto

    Range("C1").Formula = "=""'""&TEXTJOIN(""', '"",TRUE,A1:A" & fStep + 10 & ")&""'"""

(si vede la differenza, vero?)

[marcopont]

perfect


grazie mille