Macro che copia tabelle su fogli determinati

[alberto80]

Salve sono nuovamente alla ricerca di un ulteriore aiuto, piano piano con le vostre informazioni e con i contenuti dei post di altri utenti sto aggiungendo macro su macro per archiviare in maniera corretta le informazioni.

Avrei necessità di una macro che abbia la capacità di ricercare all'interno di un foglio denominato "indice" dei dati e copiarli su dei fogli determinati se esistenti.

In allegato esempio : http://ge.tt/6Kx8C8o2

step:
1) Nel foglio indice nella colonna "C" la macro trova il primo nome foglio ne verifica l'esistenza .
2) Se il foglio esiste copia tutti i dati (dato1,2,3,4) fino alla riga vuota e li incolla sul foglio di nome corrispondente.
3) la copia nel foglio corrispondente sarà complicata dal fatto che le celle di destinazione sono unite:
Esempio: Sul foglio indice il riferimento "1" (nome del foglio) presenta il primo Dato1 nella cella D5 che verrà copiato nel foglio di destinazione "1" nelle celle C11:D11.
4)La macro continua fino a quando nella colonna C del foglio indice non incontra più fogli o 2 o più righe vuote.

NB: come mi avete insegnato invece del copia e incolla sarà da usare la funzione "PasteSpecial" per evitare di modificare i bordi delle celle di destinazione.

Grazie come sempre per un eventuale aiuto.

[Anthony47]

Eh he, non mi e' chiaro su quali delle cose che hai elencato stai chiedendo un aiuto...

Inoltre non capisco il motivo per cui usi le celle unite, se sai gia' che la copia su celle unite genera problemi.

Ciao

[alberto80]

Ciao Anthony mi servirebbe conoscere la l'istruzione che permette ad excel di confrontare un nome di una cella con il nome di un foglio, e la successiva istruzione di stop se incontra una riga vuota; questo per creare una routine in cui la macro in base al nome del foglio corrispondente inserisca i dati necessari fino ad interrompersi alla riga vuota.

Si in effetti immaginavo che poteva essere un problema in tal caso provvederò a modificare la struttura tabellare dei fogli di destinazione.

Data la mia bassa conoscenza di excel pensavo che poteva esserci una fattibilità magari non complessa di affrontare il problema.

Grazie.

[Anthony47]

Per controllare se un foglio esiste puoi usare ad esempio questa funzione:

Codice: Seleziona tutto

Function ShExists(ByVal ShName As String) As Boolean
Dim ckEr As String
'
On Error Resume Next
    ckEr = Sheets(ShName).Name
On Error GoTo 0
ShExists = (ckEr = ShName)
End Function


Va messa in un modulo standard del vba, es Modulo1, poi la richiami col nome del foglio; restituira' Vero /Falso a seconda che quel foglio esista o meno nel file attivo. Esempio

Codice: Seleziona tutto

If ShExists(Range("A2").Value) Then
'Cosa fare se il foglio esiste
Else
'Cosa fare se il foglio non esiste
End If

Per individuare dove un'area si "interrompe" puoi usare "CurrentRegion"; esempio se sai che i dati sono in colonne D:G e sei posizionato in C5 (dove hai letto il nome del Foglio), e sai che sul foglio di destinazione i dati vanno incollati in C11, allora potresti usare

Codice: Seleziona tutto

currSheet = CStr(ActiveCell.Value)
If ShExists(currSheet) Then
    Application.Intersect(Range("D:G"), ActiveCell.CurrentRegion).Copy
    Sheets(currSheet).Range("C11").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End If


Per sapere quando non ci sono altri nomi di foglio in colonna C bastera' che fai un loop tra la prima riga da testare (5, nell'esempio che hai pubblicato) e l'ultima riga valorizzata di colonna C, che calcoli con Cells(Rows.count,"C").End(xlup).row; esempio:

Codice: Seleziona tutto

For I = 5 To Cells(Rows.Count, "C").End(xlUp).Row
    If Cells(I, "C") <> "" Then  'Esiste un nome foglio in cella
        'cosa fare?
    End If
Next I


Dai, vediamo quanto hai gia' imparato; ma se ti areni sai che siamo qui e guarderemo insieme.

Ciao

[alberto80]

Grazie Anthony per la spiegazione dettagliata, ci provo e vi faccio sapere.

[alberto80]

Salve,

Ho provato ad eseguire i vostri consigli e alla fine sono riuscito a creare un foglio che in base all'elenco nella pagina indice riesce a generare i fogli mancanti se non presenti, ponendoli in coda.

onestamente non sono riuscito a fare la cosa più importante, indirizzare la copia per ogni foglio in base all'elenco tenendo in considerazione lo spazio vuoto tra le tabelle.

Suppongo che si debba creare un ciclo che di volta in volta copia i dati della tabella relativa sul primo foglio poi trovato lo spazio vuoto passa al secondo foglio e cosi via.

mi sapreste dare maggiori indicazioni?

Per ora il risultato è il seguente : http://ge.tt/5QjYPAo2

Grazie.

[Anthony47]

L'esperimento didattico ha dato qualche frutto, pero' la stai facendo piu' complicata di quel che deve essere...

Intanto su Elenco elimina le celle unite di colonna C; la loro presenza da' solo fastidio e complicherebbe inultilmente il codice.
Poi prendi nota che all'interno dei "moduli vba" dei singoli fogli di lavoro va messo solo il codice relativo a "eventi" del foglio e dei suoi activex (il Pulsante). Insomma la Sub CreaFoglio(Names_Of_Sheets As Range) non dovrebbe stare dove e' stata inserita; ma ne faremo a meno (useremo solo le due istruzioni che generano eventualmente un foglio mancante), quindi la puoi cancellare.

Modulo1 mi pare che contenga solo delle sub dimostrative, puoi togliere il modulo quando vuoi

Teniamo poi la Function ShExists su Modulo5, e sullo stesso Modulo5 aggiungiamo la macro che controlla tutto:

Codice: Seleziona tutto

Sub globAlb()
Dim I As Long, lastSh As Long, currSheet As String
Dim myNext As Long, myR
'
Sheets("Elenco").Select
lastSh = Cells(Rows.Count, "C").End(xlUp).Row
For I = 5 To lastSh
    currSheet = Cells(I, "C")
    If currSheet <> "" Then
        If Not ShExists(currSheet) Then
                Worksheets.Add after:=Worksheets.Count
                ActiveSheet.Name = cSh
        End If
        Sheets("Elenco").Select
        myNext = Sheets(currSheet).Cells(Rows.Count, "C").End(xlUp).Row + 1
        Set myR = Application.Intersect(Range("D:G"), Cells(I, "C").CurrentRegion)
        If Not myR Is Nothing Then
            myR.Copy
            Sheets(currSheet).Cells(myNext, "C").PasteSpecial xlPasteValues  'Nota**
        End If
        Application.CutCopyMode = False
    End If
Next I
End Sub


Associamo questa macro al pulsante di Elenco, modificando come segue il codice presente sul modulo vba del foglio "Elenco"

Codice: Seleziona tutto

Private Sub CommandButton1_Click()
'Call CreaFoglio(Sheets("Elenco").Range("c5:c35"))    '<<< Si puo' anche eliminare
Call globAlb                                          '<<< AGGIUNTA
End Sub


Nota**: Tuttavia fino ad ora non hai spiegato in che posizione del foglio destinatario vorresti incollare il contenuto di foglio Elenco; mi sono pertanto arbitrariamente immaginato che il tutto va in coda a quanto gia' presente in colonna C
Se hai in mente un'altra logica allora devi descriverla e vedremo come si codifica.

Intanto prova come ti ho detto e vedi se utile.

Ciao

[alberto80]

Eccomi ero rimasto senza connessione per servizio dell'operatore telefonico, Grazie nuovamente Anthony si in effetti mi ero incartato e probabilmente non sarei riuscito a proseguire senza il tuo aiuto; sono contento di questo forum perché trovo molti spunti nelle varie conversazioni ed esempi che posso applicare ai miei fogli; vi auguro una buona giornata a tutti.