Realizzazione Macro per recupero dati

Question

Ciao David

Ho una domanda porvi

Mi serve un comando macro per fare in modo che delle informazioni contenute in un riga qualsiasi di un foglio definito di "inserimento dati"  venga copiata come singola riga e poi trasferita in un foglio a parte di elaborazione dati e ogni volta tale riga venga incollata nella prima riga libera che trova nel foglio di destinazione, la mia difficoltà nel riuscire a fare tale comando sta nel fatto che la riga da copiare dal foglio di inserimento dati può essere ogni volta diversa e compresa tra la riga 2 e la riga 200 la riga da copiare deve essere subordinata al clik effettuato su un collegamento ipertestuale contenuto nella colonna B il quale è presente in tutte le righe dalla 2 all 200 e cliccando sul quale si va ad elaborare un documento in PDF.

Spero di essere stato abbastanza chiaro

se hai problemi fammi sapere

ciao Cristian

Answer 1

Ciao Cristian,

Const sColonne_da_Copiare As String = "A:AV"                 '<<=== Modifica

    Const sFoglio_Destinazione As String = "Foglio3"           '<<=== Modifica 

Il foglio 3 lo richiamerò io come mi servirà in seguito

Ho scaricato il tuo file e credo che il problema principale sia che sul foglio Inserimento dati siano presenti righe nascoste.

Per superare il problema, nel modulo di codice del foglio Inserimento datiincolla il seguente codice:

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

Option Explicit

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

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

    Dim destSH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim LRow As Long

    Const sColonne_da_Copiare As String = "A:AV"                 '<<=== Modifica

    Const sFoglio_Destinazione As String = "Foglio3"              '<<=== Modifica

    Set srcRng = Intersect(ActiveCell.EntireRow, _

                           Me.Columns(sColonne_da_Copiare))

    Set destSH = ThisWorkbook.Sheets(sFoglio_Destinazione)

    With destSH

        Debug.Print Target.Range.Cells.Count

        LRow = LastRow(destSH, .Columns(sColonne_da_Copiare))

        Set destRng = .Range("A" & LRow + 1)

    End With

    srcRng.Copy Destination:=destRng

End Sub

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

In un modulo standard, incolla:

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

Option Explicit

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

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

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

===

Regards,

Norman

Answer 2

Solo per conferma il file ti è arrivato ?

ciao

Answer 3

Ciao Cristian,

Ciao Purtroppo pe policy aziendale non riesco a caricare i file su nessuna delle due piattaforme mi hai girato posso solo inviarti una copi via email

se puoi mandarmi gli estremi posso girarti il file 

Se fai clic sul mio profilo troverai un indirizzo e-mail decifrabile.

===

Regards,

Norman

Answer 4

Ciao Purtroppo pe policy aziendale non riesco a caricare i file su nessuna delle due piattaforme mi hai girato posso solo inviarti una copi via email

se puoi mandarmi gli estremi posso girarti il file

ciao

Answer 5

Ciao Cristian,

Ciao sono riuscito a farlo funzionare,( avevo una impostazione che bloccava l'esecuzione della macro generale),

ma ha ancora un problema,

la prima riga viene copiata correttamente al secondo passaggio la riga viene copiata nella seconda riga, alla terza selezione la copia non avviene su una terza riga ma sempre sulla seconda e cosi per tutte le successive azioni  e quindi vengono sovrascritte e non si forma il data base che vorrei che si formasse.

riesci a capire come mai 

A me. sempre utilizzando il mio file di prova, le righe del primo foglio vengono copiate sulla prima riga vuota del secondo foglio e nessuna riga viene mai sovvrascritta.

Pertanto, ti chiederei gentilmente di caricare il file problematico.

===

Regards,

Norman