Copiare dato su prima eventuale cella vuota tra tre fogli

Question

Buongiorno a tutti, espongo il mio problema:

Dovrei copiare il valore della cella attiva nel primo foglio nella prima cella libera della colonna A del secondo foglio partendo dall’alto (attenzione la colonna si presenta per es. come un susseguirsi di celle piena piena vuota piena vuota). Se tutte le celle del secondo foglio sono piene deve copiare nella prima cella vuota colonna A del terzo foglio e se anche queste sono tutte piene deve copiare nella prima cella vuota colonna A del quarto. Il codice che allegherò fa questa cosa ma con un problema: se la cella vuota si trova nel 2 foglio oltre a copiare qui copia anche nella cella vuota del 4 foglio, mentre se tutte le celle del 2 foglio sono piene copia regolarmente solo nella prima cella libera del 3 foglio e se anche tutte le celle del 3 foglio sono piene copia giustamente nel 4 foglio.

Non riesco a capire il perché dell’anomalia se qualcuno mi può aiutare ringrazio fin da ora.

Sub FindFirstBlank()

V = ActiveCell

For i = 2 To 4

Worksheets(i).Activate

Dim k As Range

Set k = Intersect(Range("A:A"), Cells.SpecialCells(xlCellTypeBlanks))

If k Is Nothing Then

Else

k(1) = V

i = i + 1

End If

Next

 End Sub

Answer 1

Ciao Walter.

Ho una confessione grave da fare: pensando di aver pienamente capito la tua richiesta iniziale, ho postato il mio codice iniziale. Poi ad ogni risposta da te, ho cercato di rispondere al problema specifico sollevato da te. Di conseguenza, ho scritto modifiche ad hoc per il codice. Questo non è il modo di scrivere buon codice robusto! Piuttosto, si porta a codice ingiustificatamente complesso e poco resiliente del tipo cosiddetto codice spaghetti!

Perciò, prova invece il seguente codice che ha una struttura più semplice, più pulito e che credo sia più robusto e resistente. In ogni caso, mi sorprenderebbe se tu dovessi riscontrare alcun problema a causa del codice stesso:

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

Option Explicit

Public theCell As Range

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

Public Sub FindFirstBlank()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim i As Long, Lrow As Long

    Dim iRow As Long, jrow As Long

    Dim V As Variant

    Dim Rng As Range, Rng2 As Range, rCell As Range

    Dim bIntervalloPieno As Boolean

    Const sRange As String = "A1:A20"   '<<=== Modifica

    Set WB = ActiveWorkbook

    V = ActiveCell.Value

    If V = vbNullString Then

        Call MsgBox(Prompt:="La cella attiva e' vuota! Riprova!", _

                    Buttons:=vbCritical, _

                    Title:="CONTROLLA CELLA ATTIVA")

        Exit Sub

    End If

    For i = 2 To 4

        Set SH = WB.Worksheets(i)

        With SH

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

            Set Rng = .Range("A1:A" & Lrow)

            With .UsedRange.Columns(1)

                iRow = .Cells(.Cells.Count).Row

            End With

            On Error Resume Next

            Set Rng = .Range(sRange)

            With Rng

                jrow = .Cells(.Cells.Count).Row

            End With

            Set Rng2 = Rng.SpecialCells((xlCellTypeBlanks))

            If Not Rng2 Is Nothing Then

                Set rCell = Rng2.Cells(1)

            Else

                bIntervalloPieno = Lrow >= jrow

            End If

            If rCell Is Nothing Then

                If Not bIntervalloPieno Then

                    Set rCell = Rng.Cells(iRow + 1).End(xlUp)(2)

                End If

            End If

        End With

        If Not rCell Is Nothing Then

            rCell.Value = V

            Set theCell = rCell

            Exit For

        End If

    Next i

    If Not rCell Is Nothing Then

        Set theCell = rCell

        Application.Goto rCell

        Call SecondaMacro

    Else

        Call MsgBox(Prompt:="Non ci sono trovato una cella vuota " _

                          & "nell'intervallo " & sRange _

                          & " sui fogli interessati." _

                          & vbNewLine _

                          & "La seconda macro non e' stata avviata!", _

                    Buttons:=vbInformation, _

                    Title:="Controlla Intervalli!")

    End If

End Sub

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

Public Sub SecondaMacro()

    With theCell

        Call MsgBox(Prompt:="La cella riepita si trova a: " _

                          & .Address(0, 0, , 1), _

                    Buttons:=vbInformation, _

                    Title:="DEMO")

        .Interior.ColorIndex = 3  '\Rosso

    End With

End Sub

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

Potresti scaricare il file aggiornato Bocolo20160216.xlsm a: 

https://www.dropbox.com/s/mdabnyi0ullcfay/Bocolo20160216.xlsm?dl=0

===

Regards,

Norman

Answer 2

Ciao Norman

Ancora grazie infinite, la tua spiegazione è stata chiarissima e dettagliata e non preoccuparti per il tuo italiano se non era per il tuo commento finale ti consideravo un madrelingua, usi termini ricercati con una proprietà da far invidia al 90 percento di noi Italiani.

Ritornando al codice, se posso continuare ad abusare della tua pazienza, come immaginavo mi sono spiegato male io, e pensare che sono Italiano.... :).La cella che devo copiare non si trova nei tre fogli destinazione ma nel primo foglio. Dai un'occhiata a:

https://www.dropbox.com/s/bo5dn1kkjb6us8z/Bocolo20160215.xlsm?dl=0

e prova a copiare Gennaio dal primo foglio negli altri tre. Ho ristretto la ricerca alle prime 20 righe della colonna A dei fogli 2 3 4 quindi i fogli 2 e 4 non ricevono il valore perché pieni mentre il  foglio 3 pur essendo pieno solo fino alla riga 6 non riceve il dato perché la cella A6 è anche l'unica attiva. Io ho risolto mettendo un valore a caso nella cella A21 e quindi attivando tutte le celle precedenti. A livello pratico è quindi tutto risolto, ti rompo solo per cercare di capire meglio la teoria.

Una ultimissima cosa: mi serve spostarmi nella cella destinazione perché da li dovrei far partire una ulteriore macro, potrei avviarla in automatico con il comando Cal macro inserito nel tuo codice?

Grazie ancora di tutto.

Walter

Answer 3

Ciao Bocolo,

Grazie dell'aiuto. Chiedo scusa per il mio obbrobrio ma non sono molto esperto ed il mio codice è stato assemblato scopiazzando qua e la.

Il mio commento in materia era indirizzato al codice; non era intesa come una crtica di te e certamente non era affatto la mia intenzione di essere scortesese - anche se, a volte, posso essere un bubero!

Naturalmente il tuo funziona benissimo, ho riscontrato però un problema nel caso in cui nel terzo foglio la colonna A si presenti sul tipo pieno pieno vuoto vuoto vuoto ecc. e l'ultima cella piena sia anche l'ultima attiva. In questo caso la routine non funziona ma riconosco che non ho prospettato una caso simile nel mio primo intervento. 

Forse ho capito male ma, a me, pare che, anche cosi, il codice funzioni.

Per testarlo, nel terzo foglio ho immesso i seguenti dati:

Ho selezionato la cella A6 e dopo aver eseguito il codice, ottengo:

Come si vede, il valore della cella attiva (A6) e; stato inserito nella prima cella vuota, A3.

Potresti scaricare il mio file di prova Bocolo20160213.xlsm a:

https://www.dropbox.com/s/oq1hmgkn1g4pfn8/Bocolo20160213.xlsm?dl=0

Se posso abusare della tua competenza e della tua pazienza vorrei chiederti 3 cose:

1 se mi puoi commentare la stringa Lrow = .Cells(Rows.Count, "A").End(xlUp).Row

La proprietà Range.Cells restituisce un oggetto Range.

La proprietà Rows restituisce un oggetto Range che rappresenta tutte le righe del foglio attivo

La proprietà Rows.Count restituisce il numero di righe del foglio attivo.

L'espressione .Cells(Rows.Count, "A") restituisce un oggetto Range, ovvero l'ultima cella nella colonna A del foglio restituito dall'espressione precedente With WB.Worksheets(i)

La sintassi della proprietà Range.End  è: **Range.End (Direzione)**e restituisce la cella successiva popolata nella direzione indicata, a partire dalla Intervallo specificato; la costante xlUp indica la direzione  su. 

Finalmente, la  proprietà Row restituisce il numero della prima riga di un dato intervallo.

Quindi. mettendo tutto insieme, l'espressione originaria, ovvero

 .Cells(Rows.Count, "A").End(xlUp).Rowcerca la prima cell popolata anadando in su, dall'ultima cella in colonna A; in altre parole, restituisce l'ultima cella popolata in colonna A.

2 se per spostarmi alla fine nella cella in cui incollo il valore è giusto il comando  Application.Goto Rng.Cells(1), ovvero funziona ma volevo sapere se è corretto anche stilisticamente

Va molto bene, anche se, da una perspettiva VBA, non è nomalmente necessario, o consigliabile, selezionare un foglio o un intervallo.

3 si può limitare la ricerca della cella vuota alle prime cento righe della colonna A di ogni foglio?

Certo! Se tu hai seguito la mia spiegazione qui sopra dell'espressione

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

prova a sostituire:

        With WB.Worksheets(i)

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

            On Error Resume Next

            Set Rng = .Range("A1:A" & Lrow). _

                      SpecialCells((xlCellTypeBlanks))

        End With

con:

        With WB.Worksheets(i)

            On Error Resume Next

            Set Rng = .Range("A1:A100). _

                      SpecialCells((xlCellTypeBlanks))

        End With

Concludo con la speranza che, nonstante mio esecrabile italiono, la mia spiegazione sia comprensibile.

===

Regards,

Norman

Answer 4

Ciao Norman

Grazie dell'aiuto. Chiedo scusa per il mio obbrobrio ma non sono molto esperto ed il mio codice è stato assemblato scopiazzando qua e la.

Naturalmente il tuo funziona benissimo, ho riscontrato però un problema nel caso in cui nel terzo foglio la colonna A si presenti sul tipo pieno pieno vuoto vuoto vuoto ecc. e l'ultima cella piena sia anche l'ultima attiva. In questo caso la routine non funziona ma riconosco che non ho prospettato una caso simile nel mio primo intervento.  Se posso abusare della tua competenza e della tua pazienza vorrei chiederti 3 cose:

1 se mi puoi commentare la stringa Lrow = .Cells(Rows.Count, "A").End(xlUp).Row

2 se per spostarmi alla fine nella cella in cui incollo il valore è giusto il comando  Application.Goto Rng.Cells(1), ovvero funziona ma volevo sapere se è corretto anche stilisticamente

3 si può limitare la ricerca della cella vuota alle prime cento righe della colonna A di ogni foglio?

Grazie ancora.

Answer 5

Ciao Bocolo,

Dovrei copiare il valore della cella attiva nel primo foglio nella prima cella libera della colonna A del secondo foglio partendo dall’alto (attenzione la colonna si presenta per es. come un susseguirsi di celle piena piena vuota piena vuota). Se tutte le celle del secondo foglio sono piene deve copiare nella prima cella vuota colonna A del terzo foglio e se anche queste sono tutte piene deve copiare nella prima cella vuota colonna A del quarto. Il codice che allegherò fa questa cosa ma con un problema: se la cella vuota si trova nel 2 foglio oltre a copiare qui copia anche nella cella vuota del 4 foglio, mentre se tutte le celle del 2 foglio sono piene copia regolarmente solo nella prima cella libera del 3 foglio e se anche tutte le celle del 3 foglio sono piene copia giustamente nel 4 foglio.

Non riesco a capire il perché dell’anomalia se qualcuno mi può aiutare ringrazio fin da ora.

Sub FindFirstBlank()

V = ActiveCell

For i = 2 To 4

Worksheets(i).Activate

Dim k As Range

Set k = Intersect(Range("A:A"), Cells.SpecialCells(xlCellTypeBlanks))

If k Is Nothing Then

Else

k(1) = V

i = i + 1

End If

Next

 End Sub

Non so dove hai trovato questa routine ma a parte il fatto che credo ci siano diverse problemi con il codice, mi pare molto brutta.

Prova la seguente routine che  dovrebbe fare ciò che vuoi:

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

Option Explicit

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

Public Sub FindFirstBlank()

    Dim WB As Workbook

    Dim i As Long, Lrow As Long

    Dim V As Variant

    Dim Rng As Range

    Set WB = ActiveWorkbook

    V = ActiveCell.Value

    For i = 2 To 4

        With WB.Worksheets(i)

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

            On Error Resume Next

            Set Rng = .Range("A1:A" & Lrow). _

                      SpecialCells((xlCellTypeBlanks))

        End With

        If Not Rng Is Nothing Then

            Rng.Cells(1).Value = V

            Exit Sub

        End If

    Next i

End Sub

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

===

Regards,

Norman