Trasferimento dati tra files

[BG66]

Buona Domenica.
Purtroppo il solito ...abituale...AIUTO.
In pratica con questo script trasferisco dati da un foglio ad un altro nello stesso file (NearMiss-Investigation vForum1.xlsm):

Codice: Seleziona tutto

Sub CreaDBInt()
Dim r, c, sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Worksheets("DB_NearMiss")
Set sh2 = Worksheets("Near Miss Modulo01")
sh1.Activate
Application.ScreenUpdating = False
    r = sh1.Cells(Rows.Count, 1).End(xlUp).Row + 1
        'prima nr riga e poi colonna
        sh1.Cells(r, 1) = sh2.Cells(4, 4) 'Nr. ID Evento
        sh1.Cells(r, 2) = sh2.Cells(7, 4) ' Unità Prod
        sh1.Cells(r, 3) = sh2.Cells(7, 6) ' Reparto
        sh1.Cells(r, 4) = sh2.Cells(3, 3) ' Tipo Evento
        sh1.Cells(r, 5) = sh2.Cells(4, 6) ' Data Segnalazione
        sh1.Cells(r, 6) = sh2.Cells(10, 5) ' Segnalatore
        sh1.Cells(r, 7) = sh2.Cells(16, 3) ' Descrizione
       
MsgBox "Aggiornamento completato", vbInformation
Application.ScreenUpdating = True
    Set sh1 = Nothing
    Set sh2 = Nothing

End Sub

Ma NON succede nulla quando provo a spostare gli stessi dati in una tabella di un foglio posizionato in un file esterno (Report-Infortuni---Near-miss vForum1.xlsm):

Codice: Seleziona tutto

Sub CreaDBExt()
'dichiaro le variabili
Dim r, c, wk1 As Workbook, wk2 As Workbook, sh1 As Worksheet, sh2 As Worksheet

'gestione errori
On Error GoTo RigaErrore
    Application.ScreenUpdating = False

'metto i riferimenti ai files
    Set wk1 = ThisWorkbook
    Set wk2 = Workbooks.Open(wk1.path & "/" & "Report-Infortuni---Near-miss vForum1.xlsm")

'metto i riferimenti ai fogli
    Set sh1 = wk1.Worksheets("Near Miss Modulo01")
    Set sh2 = wk2.Worksheets("DB_NearMiss")

 With sh1

'copio i dati da un file all'altro
        sh1.Activate
        Application.ScreenUpdating = False
            r = sh1.Cells(Rows.Count, 1).End(xlUp).Row + 1
        'prima nr riga e poi colonna
            sh1.Cells(r, 1) = sh2.Cells(4, 4) 'Nr. ID Evento
        sh1.Cells(r, 2) = sh2.Cells(7, 4) ' Unità Prod
        sh1.Cells(r, 3) = sh2.Cells(7, 6) ' Reparto
        sh1.Cells(r, 4) = sh2.Cells(3, 3) ' Tipo Evento
        sh1.Cells(r, 5) = sh2.Cells(4, 6) ' Data Segnalazione
        sh1.Cells(r, 6) = sh2.Cells(10, 5) ' Segnalatore
        sh1.Cells(r, 7) = sh2.Cells(16, 3) ' Descrizione
       
MsgBox "Trasferimento dati completato", vbInformation
       End With

'salvo le modifiche e chiudo il secondo file
 wk2.Save
 wk2.Close

 Application.ScreenUpdating = True

'riga sempre eseguita
RigaChiusura:

'Set a Nothing delle variabili oggetto
    Set sh2 = Nothing
    Set sh1 = Nothing
    Set wk1 = Nothing
    Set wk2 = Nothing

    Exit Sub

'in caso di errore
RigaErrore:
    MsgBox Err.Number & vbNewLine & Err.Description
    Resume RigaChiusura

End Sub


Spero e temo che sia una questione di lana caprina... ma comunque NON ci arrivo da solo

Grazie per l'aiuto.
Gene
https://www.dropbox.com/s/uau194oo9y5n3cp/Dati%20trasferiti_forum.rar?dl=0

[Anthony47]

Ma NON succede nulla quando provo a spostare gli stessi dati in una tabella di un foglio posizionato in un file esterno (Report-Infortuni---Near-miss vForum1.xlsm)

Premesso che quando leggo "non succede nulla" mi vien da rispondere "Formatta il Pc".
Ma perche' poi ti metti a copiare DA [Report-Infortuni---Near-miss vForum1.xlsm]DB_NearMiss VERSO [NearMiss-Investigation vForum1.xlsm]Near Miss Modulo01?
Perche' questo fanno le righe

Codice: Seleziona tutto

        sh1.Cells(r, 1) = sh2.Cells(4, 4) 'Nr. ID Evento
        sh1.Cells(r, 2) = sh2.Cells(7, 4) ' Unità Prod
'etc etc


Insomma, se la descrizione e' corretta dovresti invertire le dichiarazioni: sh1 e' da associare al file/foglio di destinazione e sh2 al file/foglio di origine
Nota: ma e' così difficile usare shDest e sgSorg invece che sh1 e sh2 (o sh2 e sh1), che renderebbe un minimo utile l'assegnazione?

Inoltre le istruzioni With sh1 /End With sono inutili, visto che nessuna istruzione usa poi questa condizione.

Ciao

[BG66]

[RISOLTO]
Ciao Anthony

Premesso che quando leggo "non succede nulla" mi vien da rispondere "Formatta il Pc".

Purtroppo Non trovavo un altro modo per descrivere quello che lo script NON faceva

Comunque grazie alle tue dritte ora TUTTO FUNZIONA (.... e non ti scrivo cosa!!! ) e lo script finale è il seguente:

Codice: Seleziona tutto

Sub CreaDBExt()
'dichiaro le variabili
Dim r, c, wk1 As Workbook, wk2 As Workbook, shSorg As Worksheet, shDest As Worksheet

'gestione errori
On Error GoTo RigaErrore
    Application.ScreenUpdating = False

'metto i riferimenti ai files
    Set wk1 = ThisWorkbook
    Set wk2 = Workbooks.Open(wk1.path & "/" & "Report-Infortuni---Near-miss vForum1.xlsm")

'metto i riferimenti ai fogli
    Set shSorg = wk1.Worksheets("Near Miss Modulo01")
    Set shDest = wk2.Worksheets("DB_NearMiss")

'copio i dati da un file all'altro
        shSorg.Activate
        Application.ScreenUpdating = False
        r = shDest.Cells(Rows.Count, 1).End(xlUp).Row + 1
        'prima nr riga e poi colonna
            shDest.Cells(r, 1) = shSorg.Cells(4, 4) 'Nr. ID Evento
            shDest.Cells(r, 2) = shSorg.Cells(7, 4) ' Unità Prod
            shDest.Cells(r, 3) = shSorg.Cells(7, 6) ' Reparto
            shDest.Cells(r, 4) = shSorg.Cells(3, 3) ' Tipo Evento
            shDest.Cells(r, 5) = shSorg.Cells(4, 6) ' Data Segnalazione
            shDest.Cells(r, 6) = shSorg.Cells(10, 5) ' Segnalatore
            shDest.Cells(r, 7) = shSorg.Cells(16, 3) ' Descrizione
       
MsgBox "Trasferimento dati completato", vbInformation

'salvo le modifiche e chiudo il secondo file
 wk2.Save
 wk2.Close

 Application.ScreenUpdating = True

'riga sempre eseguita
RigaChiusura:

'Set a Nothing delle variabili oggetto
    Set shDest = Nothing
    Set shSorg = Nothing
    Set wk1 = Nothing
    Set wk2 = Nothing

    Exit Sub

'in caso di errore
RigaErrore:
    MsgBox Err.Number & vbNewLine & Err.Description
    Resume RigaChiusura

End Sub


Grazie mille.
Gene