Risultati da 1 a 19 di 19

Discussione: Copiare dati fra 2 fogli excel



  1. #1
    L'avatar di wallera
    Clicca e Apri
    Data Registrazione
    Sep 2016
    Località
    Milano
    Messaggi
    11
    Versione Office
    2013
    Mi Piace ricevuti
    0
    Mi Piace dati
    0

    Copiare dati fra 2 fogli excel

    Ciao a tutti,
    ho bisogno del vostro aiuto...
    ho 2 file excel, vorrei che il file excel2 (situato nella cartella C:\Users\xxxx\xxxx ) copiasse in automatico delle colonne del file excel1 se nella colonna "D" del file excel1 ci siano i valori impostati come segue:


    il foglio su cui lavoro è il excel1 , quello che si deve aggiornare in automatico è excel2 seguendo questi parametri ( il file excel2 si trova in un percorso di cartelle diverse rispetto al excel1) :

    Ho caricato i 2 file su Gdrive : https://drive.google.com/open?id=0Bz...kg4alBNaDRoNnM


    copia la colonna "H" (GRUPPO) del file excel1 nella colonna "A" del file excel2
    copia la colonna "B" (DATA) del file excel1 nella colonna "B" del file excel2
    copia la colonna "D" (N.GIORNI) del file excel1 nella colonna "C" del file excel2
    copia la colonna "E" (LOCALITA) del file excel1 nella colonna "D" del file excel2
    copia la colonna "A" (PRODOTTO) del file excel1 nella colonna "E" del file excel2
    copia la colonna "G" (VIAGGIO) del file excel1 nella colonna "F" del file excel2
    copia la colonna "I" (VENDITA) del file excel1 nella colonna "G" del file excel2
    copia la colonna "J" (COSTI) del file excel1 nella colonna "H" del file excel2
    copia la colonna "K" (ALLOTMENT) del file excel1 nella colonna "I" del file excel2
    copia la colonna "L" (STATUS) del file excel1 nella colonna "J" del file excel2
    copia la colonna "M" (SCADENZA) del file excel1 nella colonna "K" del file excel2
    copia la colonna "N" (DOCUMENTI) del file excel1 nella colonna "L" del file excel2
    queste colonne vanno copiate solo se nella colonna "L" (STATUS) del file excel1 ci siano i seguenti valori : "OPZ" "VOID" "OK"
    ultima nota nel file excel1 ci saranno valori con collegamenti ipertestuali a file in diverse cartelle che dovrebbero rimanere anche nel file excel2,
    nell file excel1 ci saranno dei riempimenti di colore, nel file excel2 deve essere tutto bianco e uniforme.

  2. #2

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    4006
    Versione Office
    2011/2016MAC
    Mi Piace ricevuti
    1260
    Mi Piace dati
    761

    Re: Copiare dati fra 2 fogli excel

    Ciao,
    prova con questo codice da mettere in un modulo standard del file Excel1
    Codice: 
    Sub Copia_in_Excel2()
    Dim WK1 As Workbook, WK2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim uRiga As Long, y As Long, x As Integer
            Application.ScreenUpdating = False
                Set WK1 = ThisWorkbook
                Set WK2 = Workbooks.Open(WK1.Path & "\" & "excel2.xlsx")
                Set sh1 = WK1.Worksheets("BOOKING")
                Set sh2 = WK2.Worksheets("BOOKING")
                    With sh1
                        uRiga = sh1.Cells(Rows.Count, 1).End(xlUp).Row
                        x = 2
                        For y = 2 To uRiga
                If .Cells(y, 12) = "OPZ" Or .Cells(y, 12) = "VOID" Or .Cells(y, 12) = "OK" Then
                        sh2.Cells(x, 1) = .Cells(y, 8)
                        sh2.Cells(x, 2) = .Cells(y, 2)
                        sh2.Cells(x, 3) = .Cells(y, 4)
                        sh2.Cells(x, 4) = .Cells(y, 5)
                        sh2.Cells(x, 5) = .Cells(y, 1)
                        sh2.Cells(x, 6) = .Cells(y, 7)
                        sh2.Cells(x, 7) = .Cells(y, 9)
                        sh2.Cells(x, 8) = .Cells(y, 10)
                        sh2.Cells(x, 9) = .Cells(y, 11)
                        sh2.Cells(x, 10) = .Cells(y, 12)
                        sh2.Cells(x, 11) = .Cells(y, 13)
                        sh2.Cells(x, 12) = .Cells(y, 14)
                        x = x + 1
               End If
               Next
               End With
               Application.CutCopyMode = False
                WK2.Save
                WK2.Close
            Application.ScreenUpdating = True
        Set sh2 = Nothing
        Set sh1 = Nothing
        Set WK1 = Nothing
        Set WK2 = Nothing
    End Sub
    N.B. - Il file excel2 deve stare nella stessa posizione del file excel1(nella stessa cartella, sul desktop, ecc)
    La routine copia i dati come richiesti da excel1 a excel2 (quest'ultimo resta chiuso)
    File Allegati File Allegati
    Ultima modifica fatta da:ges; 15/09/16 alle 20:41 Motivo: Corretta variabile
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  3. #3
    L'avatar di Dillina
    Clicca e Apri
    Data Registrazione
    Aug 2016
    Località
    Tenerife
    Messaggi
    1175
    Versione Office
    2013
    Mi Piace ricevuti
    143
    Mi Piace dati
    601

    Re: Copiare dati fra 2 fogli excel

    Benvenuto Wallera!
    Anche noi abbiamo bisogno del tuo aiuto ...
    che ti presenti QUI
    Sii gentile quando possibile. È sempre possibile
    (Dalai Lama)

  4. #4
    L'avatar di wallera
    Clicca e Apri
    Data Registrazione
    Sep 2016
    Località
    Milano
    Messaggi
    11
    Versione Office
    2013
    Mi Piace ricevuti
    0
    Mi Piace dati
    0

    Re: Copiare dati fra 2 fogli excel

    Citazione Originariamente Scritto da Dillina Visualizza Messaggio
    Benvenuto Wallera!
    Anche noi abbiamo bisogno del tuo aiuto ...
    che ti presenti QUI
    fatto!

  5. #5
    L'avatar di wallera
    Clicca e Apri
    Data Registrazione
    Sep 2016
    Località
    Milano
    Messaggi
    11
    Versione Office
    2013
    Mi Piace ricevuti
    0
    Mi Piace dati
    0

    Re: Copiare dati fra 2 fogli excel

    Citazione Originariamente Scritto da ges Visualizza Messaggio
    Ciao,
    prova con questo codice da mettere in un modulo standard del file Excel1
    Codice: 
    Sub Copia_in_Excel2()
    Dim WK1 As Workbook, WK2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim uRiga As Long, y As Long, x As Integer
            Application.ScreenUpdating = False
                Set WK1 = ThisWorkbook
                Set WK2 = Workbooks.Open(WK1.Path & "\" & "excel2.xlsx")
                Set sh1 = WK1.Worksheets("BOOKING")
                Set sh2 = WK2.Worksheets("BOOKING")
                    With sh1
                        uRiga = sh1.Cells(Rows.Count, 1).End(xlUp).Row
                        x = 2
                        For y = 2 To uRiga
                If .Cells(y, 12) = "OPZ" Or .Cells(y, 12) = "VOID" Or .Cells(y, 12) = "OK" Then
                        sh2.Cells(x, 1) = .Cells(y, 8)
                        sh2.Cells(x, 2) = .Cells(y, 2)
                        sh2.Cells(x, 3) = .Cells(y, 4)
                        sh2.Cells(x, 4) = .Cells(y, 5)
                        sh2.Cells(x, 5) = .Cells(y, 1)
                        sh2.Cells(x, 6) = .Cells(y, 7)
                        sh2.Cells(x, 7) = .Cells(y, 9)
                        sh2.Cells(x, 8) = .Cells(y, 10)
                        sh2.Cells(x, 9) = .Cells(y, 11)
                        sh2.Cells(x, 10) = .Cells(y, 12)
                        sh2.Cells(x, 11) = .Cells(y, 13)
                        sh2.Cells(x, 12) = .Cells(y, 14)
                        x = x + 1
               End If
               Next
               End With
               Application.CutCopyMode = False
                WK2.Save
                WK2.Close
            Application.ScreenUpdating = True
        Set sh2 = Nothing
        Set sh1 = Nothing
        Set WK1 = Nothing
        Set WK2 = Nothing
    End Sub
    N.B. - Il file excel2 deve stare nella stessa posizione del file excel1(nella stessa cartella, sul desktop, ecc)
    La routine copia i dati come richiesti da excel1 a excel2 (quest'ultimo resta chiuso)
    FUNZIONA BENISSIMO,GRAZIE MILLE.. non sai quante ore di lavoro mi hai fatto risparmiare...
    c'è solo un problema

    non copia i collegamenti ipertestuali che sono presenti nel file excel1 è fondamentale...

    come posso risolvere?

    inoltre se possibile ti chiedo di mettere i commenti nel codice cosi da modificarlo ...

  6. #6

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    4006
    Versione Office
    2011/2016MAC
    Mi Piace ricevuti
    1260
    Mi Piace dati
    761

    Re: Copiare dati fra 2 fogli excel

    Citazione Originariamente Scritto da wallera Visualizza Messaggio
    .
    non copia i collegamenti ipertestuali che sono presenti nel file excel1 è fondamentale...
    come posso risolvere?
    ...
    Non mi ero accorto dei collegamenti ipertestuali, cambia il codice che ti ho postato prima con questo:
    Codice: 
    Sub Copia_in_Excel2()
    Dim WK1 As Workbook, WK2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim uRiga As Long, y As Long, x As Integer
            Application.ScreenUpdating = False
                Set WK1 = ThisWorkbook
                Set WK2 = Workbooks.Open(WK1.Path & "\" & "excel2.xlsx")
                Set sh1 = WK1.Worksheets("BOOKING")
                Set sh2 = WK2.Worksheets("BOOKING")
                    With sh1
                        uRiga = sh1.Cells(Rows.Count, 1).End(xlUp).Row
                        x = 2
                        For y = 2 To uRiga
                If .Cells(y, 12) = "OPZ" Or .Cells(y, 12) = "VOID" Or .Cells(y, 12) = "OK" Then
                        .Cells(y, 8).Copy Destination:=sh2.Cells(x, 1)
                        .Cells(y, 2).Copy Destination:=sh2.Cells(x, 2)
                        .Cells(y, 4).Copy Destination:=sh2.Cells(x, 3)
                        .Cells(y, 5).Copy Destination:=sh2.Cells(x, 4)
                        .Cells(y, 1).Copy Destination:=sh2.Cells(x, 5)
                        .Cells(y, 7).Copy Destination:=sh2.Cells(x, 6)
                        .Cells(y, 9).Copy Destination:=sh2.Cells(x, 7)
                        .Cells(y, 10).Copy Destination:=sh2.Cells(x, 8)
                        .Cells(y, 11).Copy Destination:=sh2.Cells(x, 9)
                        .Cells(y, 12).Copy Destination:=sh2.Cells(x, 10)
                        .Cells(y, 13).Copy Destination:=sh2.Cells(x, 11)
                        .Cells(y, 14).Copy Destination:=sh2.Cells(x, 12)
                        x = x + 1
               End If
               Next
               End With
               Application.CutCopyMode = False
                WK2.Save
                WK2.Close
            Application.ScreenUpdating = True
        Set sh2 = Nothing
        Set sh1 = Nothing
        Set WK1 = Nothing
        Set WK2 = Nothing
    End Sub
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  7. #7

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    4006
    Versione Office
    2011/2016MAC
    Mi Piace ricevuti
    1260
    Mi Piace dati
    761

    Re: Copiare dati fra 2 fogli excel

    Ti posto i commenti al codice
    Codice: 
    Sub Copia_in_Excel2()
    
    
    Dim WK1 As Workbook, WK2 As Workbook, sh1 As Worksheet, sh2 As Worksheet 'dichiaro le variabili
    Dim uRiga As Long, y As Long, x As Integer
    
    
    
    
            Application.ScreenUpdating = False ' disabilito lo sfarfallio dello schermo durante l'esecuzione della macro
                
                
                Set WK1 = ThisWorkbook
                Set WK2 = Workbooks.Open(WK1.Path & "\" & "excel2.xlsx") 'assegno le variabili ("excel2.xlsx" è il nome del file con la sua estensione)
                Set sh1 = WK1.Worksheets("BOOKING")
                Set sh2 = WK2.Worksheets("BOOKING")
                    
                    
                    With sh1
                        uRiga = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'trovo l'ultima riga piena del primo file
                        x = 2
                        For y = 2 To uRiga 'creo un ciclo che spazzola dalla riga 2 fino all'ultima piena
                If .Cells(y, 12) = "OPZ" Or .Cells(y, 12) = "VOID" Or .Cells(y, 12) = "OK" Then 'assegno le condizioni che se sono vere....
                
                
                        .Cells(y, 8).Copy Destination:=sh2.Cells(x, 1) '.....copio le righe corrispondenti alle condizioni sopra
                        .Cells(y, 2).Copy Destination:=sh2.Cells(x, 2)
                        .Cells(y, 4).Copy Destination:=sh2.Cells(x, 3)
                        .Cells(y, 5).Copy Destination:=sh2.Cells(x, 4)
                        .Cells(y, 1).Copy Destination:=sh2.Cells(x, 5)
                        .Cells(y, 7).Copy Destination:=sh2.Cells(x, 6)
                        .Cells(y, 9).Copy Destination:=sh2.Cells(x, 7)
                        .Cells(y, 10).Copy Destination:=sh2.Cells(x, 8)
                        .Cells(y, 11).Copy Destination:=sh2.Cells(x, 9)
                        .Cells(y, 12).Copy Destination:=sh2.Cells(x, 10)
                        .Cells(y, 13).Copy Destination:=sh2.Cells(x, 11)
                        .Cells(y, 14).Copy Destination:=sh2.Cells(x, 12)
                        x = x + 1
               End If
               Next
               End With
               Application.CutCopyMode = False 'disabilito le impostazione di copia/taglia (i trattini che si vedono dopo aver fatto copia)
    
                WK2.Save 'salvo le modifiche nel file 2
                
                WK2.Close ' chiudo il file 2
                
            Application.ScreenUpdating = True 'ripristino le impostazioni per lo schermo
            
        Set sh2 = Nothing 'distruggo le assegnazioni delle variabili
        Set sh1 = Nothing
        Set WK1 = Nothing
        Set WK2 = Nothing
    End Sub
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  8. #8
    L'avatar di wallera
    Clicca e Apri
    Data Registrazione
    Sep 2016
    Località
    Milano
    Messaggi
    11
    Versione Office
    2013
    Mi Piace ricevuti
    0
    Mi Piace dati
    0

    Re: Copiare dati fra 2 fogli excel

    Citazione Originariamente Scritto da ges Visualizza Messaggio
    Ti posto i commenti al codice
    Codice: 
    Sub Copia_in_Excel2()
    
    
    Dim WK1 As Workbook, WK2 As Workbook, sh1 As Worksheet, sh2 As Worksheet 'dichiaro le variabili
    Dim uRiga As Long, y As Long, x As Integer
    
    
    
    
            Application.ScreenUpdating = False ' disabilito lo sfarfallio dello schermo durante l'esecuzione della macro
                
                
                Set WK1 = ThisWorkbook
                Set WK2 = Workbooks.Open(WK1.Path & "\" & "excel2.xlsx") 'assegno le variabili ("excel2.xlsx" è il nome del file con la sua estensione)
                Set sh1 = WK1.Worksheets("BOOKING")
                Set sh2 = WK2.Worksheets("BOOKING")
                    
                    
                    With sh1
                        uRiga = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'trovo l'ultima riga piena del primo file
                        x = 2
                        For y = 2 To uRiga 'creo un ciclo che spazzola dalla riga 2 fino all'ultima piena
                If .Cells(y, 12) = "OPZ" Or .Cells(y, 12) = "VOID" Or .Cells(y, 12) = "OK" Then 'assegno le condizioni che se sono vere....
                
                
                        .Cells(y, 8).Copy Destination:=sh2.Cells(x, 1) '.....copio le righe corrispondenti alle condizioni sopra
                        .Cells(y, 2).Copy Destination:=sh2.Cells(x, 2)
                        .Cells(y, 4).Copy Destination:=sh2.Cells(x, 3)
                        .Cells(y, 5).Copy Destination:=sh2.Cells(x, 4)
                        .Cells(y, 1).Copy Destination:=sh2.Cells(x, 5)
                        .Cells(y, 7).Copy Destination:=sh2.Cells(x, 6)
                        .Cells(y, 9).Copy Destination:=sh2.Cells(x, 7)
                        .Cells(y, 10).Copy Destination:=sh2.Cells(x, 8)
                        .Cells(y, 11).Copy Destination:=sh2.Cells(x, 9)
                        .Cells(y, 12).Copy Destination:=sh2.Cells(x, 10)
                        .Cells(y, 13).Copy Destination:=sh2.Cells(x, 11)
                        .Cells(y, 14).Copy Destination:=sh2.Cells(x, 12)
                        x = x + 1
               End If
               Next
               End With
               Application.CutCopyMode = False 'disabilito le impostazione di copia/taglia (i trattini che si vedono dopo aver fatto copia)
    
                WK2.Save 'salvo le modifiche nel file 2
                
                WK2.Close ' chiudo il file 2
                
            Application.ScreenUpdating = True 'ripristino le impostazioni per lo schermo
            
        Set sh2 = Nothing 'distruggo le assegnazioni delle variabili
        Set sh1 = Nothing
        Set WK1 = Nothing
        Set WK2 = Nothing
    End Sub
    grazie,
    i collegamenti ora funzionano,
    ho trovato solo 3 problemi :

    se nel file excel1 cancello una riga o comunque modifico una delle condizioni per copiare le righe nel file excel2 la "vecchia riga" rimane e non viene cancellata.

    con il nuovo codice mi "importa" anche la formattazione e il colore delle celle del file excel1

    nel calcolo N.GIORNO colonna "C" del file excel2 copia la formula della colonna "D" e non il valore riportato nel file excel1.
    si può rimediare?
    grazie

  9. #9

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    4006
    Versione Office
    2011/2016MAC
    Mi Piace ricevuti
    1260
    Mi Piace dati
    761

    Re: Copiare dati fra 2 fogli excel

    Ho modificato il codice secondo le tue ultime richieste, vedi se adesso va bene.

    Codice: 
     Sub Copia_in_Excel2()Dim WK1 As Workbook, WK2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim uRiga As Long, uRiga2 As Long, y As Long, x As Integer
            Application.ScreenUpdating = False
                Set WK1 = ThisWorkbook
                Set WK2 = Workbooks.Open(WK1.Path & "\" & "excel2.xlsx")
                Set sh1 = WK1.Worksheets("BOOKING")
                Set sh2 = WK2.Worksheets("BOOKING")
                uRiga2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
                sh2.Range("A2:Q" & uRiga2).ClearContents
                    With sh1
                        uRiga = sh1.Cells(Rows.Count, 1).End(xlUp).Row
                        x = 2
                        For y = 2 To uRiga
                If .Cells(y, 12) = "OPZ" Or .Cells(y, 12) = "VOID" Or .Cells(y, 12) = "OK" Then
                        sh2.Cells(x, 1) = .Cells(y, 8)
                        sh2.Cells(x, 2) = .Cells(y, 2)
                        sh2.Cells(x, 3) = .Cells(y, 4)
                        sh2.Cells(x, 4) = .Cells(y, 5)
                        sh2.Cells(x, 5) = .Cells(y, 1)
                        sh2.Cells(x, 6) = .Cells(y, 7)
                        sh2.Cells(x, 7) = .Cells(y, 9)
                        sh2.Cells(x, 8) = .Cells(y, 10)
                        .Cells(y, 11).Copy Destination:=sh2.Cells(x, 9)
                        .Cells(y, 12).Copy Destination:=sh2.Cells(x, 10)
                        .Cells(y, 13).Copy Destination:=sh2.Cells(x, 11)
                        sh2.Cells(x, 12) = .Cells(y, 14)
                        x = x + 1
               End If
               Next
               End With
               Application.CutCopyMode = False
                WK2.Save
                WK2.Close
            Application.ScreenUpdating = True
        Set sh2 = Nothing
        Set sh1 = Nothing
        Set WK1 = Nothing
        Set WK2 = Nothing
    End Sub
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  10. #10
    L'avatar di wallera
    Clicca e Apri
    Data Registrazione
    Sep 2016
    Località
    Milano
    Messaggi
    11
    Versione Office
    2013
    Mi Piace ricevuti
    0
    Mi Piace dati
    0

    Re: Copiare dati fra 2 fogli excel

    Citazione Originariamente Scritto da ges Visualizza Messaggio
    Ho modificato il codice secondo le tue ultime richieste, vedi se adesso va bene.

    Codice: 
     Sub Copia_in_Excel2()Dim WK1 As Workbook, WK2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim uRiga As Long, uRiga2 As Long, y As Long, x As Integer
            Application.ScreenUpdating = False
                Set WK1 = ThisWorkbook
                Set WK2 = Workbooks.Open(WK1.Path & "\" & "excel2.xlsx")
                Set sh1 = WK1.Worksheets("BOOKING")
                Set sh2 = WK2.Worksheets("BOOKING")
                uRiga2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
                sh2.Range("A2:Q" & uRiga2).ClearContents
                    With sh1
                        uRiga = sh1.Cells(Rows.Count, 1).End(xlUp).Row
                        x = 2
                        For y = 2 To uRiga
                If .Cells(y, 12) = "OPZ" Or .Cells(y, 12) = "VOID" Or .Cells(y, 12) = "OK" Then
                        sh2.Cells(x, 1) = .Cells(y, 8)
                        sh2.Cells(x, 2) = .Cells(y, 2)
                        sh2.Cells(x, 3) = .Cells(y, 4)
                        sh2.Cells(x, 4) = .Cells(y, 5)
                        sh2.Cells(x, 5) = .Cells(y, 1)
                        sh2.Cells(x, 6) = .Cells(y, 7)
                        sh2.Cells(x, 7) = .Cells(y, 9)
                        sh2.Cells(x, 8) = .Cells(y, 10)
                        .Cells(y, 11).Copy Destination:=sh2.Cells(x, 9)
                        .Cells(y, 12).Copy Destination:=sh2.Cells(x, 10)
                        .Cells(y, 13).Copy Destination:=sh2.Cells(x, 11)
                        sh2.Cells(x, 12) = .Cells(y, 14)
                        x = x + 1
               End If
               Next
               End With
               Application.CutCopyMode = False
                WK2.Save
                WK2.Close
            Application.ScreenUpdating = True
        Set sh2 = Nothing
        Set sh1 = Nothing
        Set WK1 = Nothing
        Set WK2 = Nothing
    End Sub
    ora non copia il formato e copia il valore,
    ma l'intestazione non la copia più ed in alcune colonne i collegamenti ipertestuali non vengono riportati..

  11. #11

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    4006
    Versione Office
    2011/2016MAC
    Mi Piace ricevuti
    1260
    Mi Piace dati
    761

    Re: Copiare dati fra 2 fogli excel

    Spiegami bene per ciascuna colonna (come hai elencato sopra) dove deve copiare il valore e dove i collegamenti e dove il formato, altrimenti non ci capiamo.
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  12. #12
    L'avatar di wallera
    Clicca e Apri
    Data Registrazione
    Sep 2016
    Località
    Milano
    Messaggi
    11
    Versione Office
    2013
    Mi Piace ricevuti
    0
    Mi Piace dati
    0

    Re: Copiare dati fra 2 fogli excel

    1. Citazione Originariamente Scritto da ges Visualizza Messaggio
      Spiegami bene per ciascuna colonna (come hai elencato sopra) dove deve copiare il valore e dove i collegamenti e dove il formato, altrimenti non ci capiamo.


    ECCOMI



    tutte le colonne (incluso l'intestazione) devono essere copiate senza nesun tipo di formattazione (colore grassetto dimensione testo ecc ecc)




    copia la colonna "H" (GRUPPO) del file excel1 nella colonna "A" del file excel2 copia valore e collegamento ipertestuale
    copia la colonna "B" (DATA) del file excel1 nella colonna "B" del file excel2 copia valore
    copia la colonna "D" (N.GIORNI) del file excel1 nella colonna "C" del file excel2 copia risultato e non formula
    copia la colonna "E" (LOCALITA) del file excel1 nella colonna "D" del file excel2 copia valore
    copia la colonna "A" (PRODOTTO) del file excel1 nella colonna "E" del file excel2 copia valore
    copia la colonna "G" (VIAGGIO) del file excel1 nella colonna "F" del file excel2 copia valore
    copia la colonna "I" (VENDITA) del file excel1 nella colonna "G" del file excel2 copia valore e collegamento ipertestuale
    copia la colonna "J" (COSTI) del file excel1 nella colonna "H" del file excel2 copia valore e collegamento ipertestuale
    copia la colonna "K" (ALLOTMENT) del file excel1 nella colonna "I" del file excel2 copia valore e collegamento ipertestuale
    copia la colonna "L" (STATUS) del file excel1 nella colonna "J" del file excel2 copia valore
    copia la colonna "M" (SCADENZA) del file excel1 nella colonna "K" del file excel2 copia valore
    copia la colonna "N" (DOCUMENTI) del file excel1 nella colonna "L" del file excel2 copia valore e collegamento ipertestuale


    queste colonne vanno copiate solo se nella colonna "L" (STATUS) del file excel1 ci siano i seguenti valori : "OPZ" "VOID" "OK"

  13. #13
    L'avatar di wallera
    Clicca e Apri
    Data Registrazione
    Sep 2016
    Località
    Milano
    Messaggi
    11
    Versione Office
    2013
    Mi Piace ricevuti
    0
    Mi Piace dati
    0

    Re: Copiare dati fra 2 fogli excel

    più che altro non capisco perchè non riporta l'intestazione...

  14. #14

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    4006
    Versione Office
    2011/2016MAC
    Mi Piace ricevuti
    1260
    Mi Piace dati
    761

    Re: Copiare dati fra 2 fogli excel

    Ciao wallera,
    è passata una settimana dall'ultimo tuo post e devo riprendere le condizioni da te richieste.

    Partiamo da questo codice che ho modellato secondo le tue ultime indicazioni scritte nel post 12 e dimmi come va.

    Codice: 
    Sub Copia_in_Excel2()
    Dim WK1 As Workbook, WK2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim uRiga As Long, uRiga2 As Long, y As Long, x As Integer
            Application.ScreenUpdating = False
                Set WK1 = ThisWorkbook
                Set WK2 = Workbooks.Open(WK1.Path & "\" & "excel2.xlsx")
                Set sh1 = WK1.Worksheets("BOOKING")
                Set sh2 = WK2.Worksheets("BOOKING")
                uRiga2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
                sh2.Range("A2:Q" & uRiga2).ClearContents
                    With sh1
                        uRiga = sh1.Cells(Rows.Count, 1).End(xlUp).Row
                        x = 2
                        For y = 2 To uRiga
                If .Cells(y, 12) = "OPZ" Or .Cells(y, 12) = "VOID" Or .Cells(y, 12) = "OK" Then
                         .Cells(y, 8).Copy Destination:=sh2.Cells(x, 1)
                        sh2.Cells(x, 2) = .Cells(y, 2)
                        sh2.Cells(x, 3) = .Cells(y, 4)
                        sh2.Cells(x, 4) = .Cells(y, 5)
                        sh2.Cells(x, 5) = .Cells(y, 1)
                        sh2.Cells(x, 6) = .Cells(y, 7)
                        sh2.Cells(x, 7) = .Cells(y, 9)
                        sh2.Cells(x, 8) = .Cells(y, 10)
                        .Cells(y, 11).Copy Destination:=sh2.Cells(x, 9)
                        .Cells(y, 12).Copy Destination:=sh2.Cells(x, 10)
                        .Cells(y, 13).Copy Destination:=sh2.Cells(x, 11)
                        .Cells(y, 14).Copy Destination:=Cells(y, 12)
                        x = x + 1
               End If
               Next
               End With
               Application.CutCopyMode = False
                WK2.Save
                WK2.Close
            Application.ScreenUpdating = True
        Set sh2 = Nothing
        Set sh1 = Nothing
        Set WK1 = Nothing
        Set WK2 = Nothing
    End Sub
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  15. #15
    L'avatar di wallera
    Clicca e Apri
    Data Registrazione
    Sep 2016
    Località
    Milano
    Messaggi
    11
    Versione Office
    2013
    Mi Piace ricevuti
    0
    Mi Piace dati
    0

    Re: Copiare dati fra 2 fogli excel

    Ho fatto una modifica perchè non copiava il collegamento ip. di alcune colonne,
    Codice: 
    Sub Copia_in_Excel2()Dim WK1 As Workbook, WK2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim uRiga As Long, uRiga2 As Long, y As Long, x As Integer
            Application.ScreenUpdating = False
                Set WK1 = ThisWorkbook
                Set WK2 = Workbooks.Open(WK1.Path & "\" & "excel2.xlsx")
                Set sh1 = WK1.Worksheets("BOOKING")
                Set sh2 = WK2.Worksheets("BOOKING")
                uRiga2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
                sh2.Range("A2:Q" & uRiga2).ClearContents
                    With sh1
                        uRiga = sh1.Cells(Rows.Count, 1).End(xlUp).Row
                        x = 2
                        For y = 2 To uRiga
                If .Cells(y, 12) = "OPZ" Or .Cells(y, 12) = "VOID" Or .Cells(y, 12) = "OK" Then
                         .Cells(y, 8).Copy Destination:=sh2.Cells(x, 1)
                        sh2.Cells(x, 2) = .Cells(y, 2)
                        sh2.Cells(x, 3) = .Cells(y, 4)
                        sh2.Cells(x, 4) = .Cells(y, 5)
                        sh2.Cells(x, 5) = .Cells(y, 1)
                        sh2.Cells(x, 6) = .Cells(y, 7)
                        sh2.Cells(x, 7) = .Cells(y, 9)
                        sh2.Cells(x, 8) = .Cells(y, 10)
                        .Cells(y, 9).Copy Destination:=sh2.Cells(x, 7)
                        .Cells(y, 10).Copy Destination:=sh2.Cells(x, 8)
                        .Cells(y, 11).Copy Destination:=sh2.Cells(x, 9)
                        .Cells(y, 12).Copy Destination:=sh2.Cells(x, 10)
                        .Cells(y, 13).Copy Destination:=sh2.Cells(x, 11)
                        .Cells(y, 14).Copy Destination:=Cells(y, 12)
                        x = x + 1
               End If
               Next
               End With
               Application.CutCopyMode = False
                WK2.Save
                WK2.Close
            Application.ScreenUpdating = True
        Set sh2 = Nothing
        Set sh1 = Nothing
        Set WK1 = Nothing
        Set WK2 = Nothing
    End Sub
    il mio unico dubbio ora è questo,
    praticamente se copia il collegamento ipertestuale copia anche la formattazione della cella? alcune celle le colorate,
    ma il colore viene riportato anche nel file 2

  16. #16

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    4006
    Versione Office
    2011/2016MAC
    Mi Piace ricevuti
    1260
    Mi Piace dati
    761

    Re: Copiare dati fra 2 fogli excel

    Quindi, per evitare lavoro inutile, mi stai dicendo che funziona tutto e che l'unico problema e la formattazione che viene copiata?
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  17. #17
    L'avatar di wallera
    Clicca e Apri
    Data Registrazione
    Sep 2016
    Località
    Milano
    Messaggi
    11
    Versione Office
    2013
    Mi Piace ricevuti
    0
    Mi Piace dati
    0

    Re: Copiare dati fra 2 fogli excel

    si esatto, le copie funzionano (collegamenti ipt. e copia valori), solo che la formattazione deve essere neutra per tutte le caselle che copia.
    riuppo i file forse cosi è più chiaro :

    https://drive.google.com/open?id=0Bz...kg4alBNaDRoNnM

  18. #18

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    4006
    Versione Office
    2011/2016MAC
    Mi Piace ricevuti
    1260
    Mi Piace dati
    761

    Re: Copiare dati fra 2 fogli excel

    Ok, ecco la modifica:

    Codice: 
    Sub Copia_in_Excel2()
    Dim WK1 As Workbook, WK2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim uRiga As Long, uRiga2 As Long, y As Long, x As Integer
            Application.ScreenUpdating = False
                Set WK1 = ThisWorkbook
                Set WK2 = Workbooks.Open(WK1.Path & "\" & "excel2.xlsx")
                Set sh1 = WK1.Worksheets("BOOKING")
                Set sh2 = WK2.Worksheets("BOOKING")
                uRiga2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
                sh2.Range("A2:Q" & uRiga2).ClearContents
                    With sh1
                        uRiga = sh1.Cells(Rows.Count, 1).End(xlUp).Row
                        x = 2
                        For y = 2 To uRiga
                If .Cells(y, 12) = "OPZ" Or .Cells(y, 12) = "VOID" Or .Cells(y, 12) = "OK" Then
                         .Cells(y, 8).Copy Destination:=sh2.Cells(x, 1)
                        sh2.Cells(x, 2) = .Cells(y, 2)
                        sh2.Cells(x, 3) = .Cells(y, 4)
                        sh2.Cells(x, 4) = .Cells(y, 5)
                        sh2.Cells(x, 5) = .Cells(y, 1)
                        sh2.Cells(x, 6) = .Cells(y, 7)
                        sh2.Cells(x, 7) = .Cells(y, 9)
                        sh2.Cells(x, 8) = .Cells(y, 10)
                        .Cells(y, 9).Copy Destination:=sh2.Cells(x, 7)
                        .Cells(y, 10).Copy Destination:=sh2.Cells(x, 8)
                        .Cells(y, 11).Copy Destination:=sh2.Cells(x, 9)
                        .Cells(y, 12).Copy Destination:=sh2.Cells(x, 10)
                        .Cells(y, 13).Copy Destination:=sh2.Cells(x, 11)
                        .Cells(y, 14).Copy Destination:=Cells(y, 12)
                        x = x + 1
               End If
               Next
               End With
               With sh2.Range("A2:Q" & uRiga2).Borders
                    .LineStyle = xlNone
               End With
               With sh2.Range("A2:Q" & uRiga2).Interior
                .ColorIndex = xlNone
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
               End With
               With sh2.Range("A2:Q" & uRiga2).Font
                 '.ColorIndex = xlAutomatic 
                 .Underline = xlUnderlineStyleNone
                 .TintAndShade = 0
              End With
               Application.CutCopyMode = False
                WK2.Save
                WK2.Close
            Application.ScreenUpdating = True
        Set sh2 = Nothing
        Set sh1 = Nothing
        Set WK1 = Nothing
        Set WK2 = Nothing
    End Sub
    Se vuoi tutto il colore del testo automatico, elimina l'apice in rosso in questa riga: '.ColorIndex = xlAutomatic
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  19. #19
    L'avatar di wallera
    Clicca e Apri
    Data Registrazione
    Sep 2016
    Località
    Milano
    Messaggi
    11
    Versione Office
    2013
    Mi Piace ricevuti
    0
    Mi Piace dati
    0

    Re: Copiare dati fra 2 fogli excel

    Citazione Originariamente Scritto da ges Visualizza Messaggio
    Ok, ecco la modifica:

    Codice: 
    Sub Copia_in_Excel2()
    Dim WK1 As Workbook, WK2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim uRiga As Long, uRiga2 As Long, y As Long, x As Integer
            Application.ScreenUpdating = False
                Set WK1 = ThisWorkbook
                Set WK2 = Workbooks.Open(WK1.Path & "\" & "excel2.xlsx")
                Set sh1 = WK1.Worksheets("BOOKING")
                Set sh2 = WK2.Worksheets("BOOKING")
                uRiga2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
                sh2.Range("A2:Q" & uRiga2).ClearContents
                    With sh1
                        uRiga = sh1.Cells(Rows.Count, 1).End(xlUp).Row
                        x = 2
                        For y = 2 To uRiga
                If .Cells(y, 12) = "OPZ" Or .Cells(y, 12) = "VOID" Or .Cells(y, 12) = "OK" Then
                         .Cells(y, 8).Copy Destination:=sh2.Cells(x, 1)
                        sh2.Cells(x, 2) = .Cells(y, 2)
                        sh2.Cells(x, 3) = .Cells(y, 4)
                        sh2.Cells(x, 4) = .Cells(y, 5)
                        sh2.Cells(x, 5) = .Cells(y, 1)
                        sh2.Cells(x, 6) = .Cells(y, 7)
                        sh2.Cells(x, 7) = .Cells(y, 9)
                        sh2.Cells(x, 8) = .Cells(y, 10)
                        .Cells(y, 9).Copy Destination:=sh2.Cells(x, 7)
                        .Cells(y, 10).Copy Destination:=sh2.Cells(x, 8)
                        .Cells(y, 11).Copy Destination:=sh2.Cells(x, 9)
                        .Cells(y, 12).Copy Destination:=sh2.Cells(x, 10)
                        .Cells(y, 13).Copy Destination:=sh2.Cells(x, 11)
                        .Cells(y, 14).Copy Destination:=Cells(y, 12)
                        x = x + 1
               End If
               Next
               End With
               With sh2.Range("A2:Q" & uRiga2).Borders
                    .LineStyle = xlNone
               End With
               With sh2.Range("A2:Q" & uRiga2).Interior
                .ColorIndex = xlNone
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
               End With
               With sh2.Range("A2:Q" & uRiga2).Font
                 '.ColorIndex = xlAutomatic 
                 .Underline = xlUnderlineStyleNone
                 .TintAndShade = 0
              End With
               Application.CutCopyMode = False
                WK2.Save
                WK2.Close
            Application.ScreenUpdating = True
        Set sh2 = Nothing
        Set sh1 = Nothing
        Set WK1 = Nothing
        Set WK2 = Nothing
    End Sub
    Se vuoi tutto il colore del testo automatico, elimina l'apice in rosso in questa riga: '.ColorIndex = xlAutomatic
    grazie sembra funzionare alla grande lo testo meglio!

Discussioni Simili

  1. Dati in excel - come visualizzarli in più fogli con ordinamento diverso
    Di pfmarro nel forum Domande su Excel in generale
    Risposte: 13
    Ultimo Messaggio: 13/10/16, 23:14
  2. Problema confronto ed inserimento dati tra 2 fogli excel
    Di Eaco80 nel forum Domande su Excel VBA e MACRO
    Risposte: 5
    Ultimo Messaggio: 28/07/16, 18:06
  3. Copiare dati di Excel su foglio Word tramite criteri
    Di fberlinetta nel forum Domande su Excel in generale
    Risposte: 11
    Ultimo Messaggio: 18/02/16, 01:27
  4. Ricerca dati distinti confrontando due record in due fogli excel
    Di AndreaGiulia nel forum Domande su Excel in generale
    Risposte: 27
    Ultimo Messaggio: 16/12/15, 22:32
  5. Copiare dati da vari fogli Excel Nuova risposta File allegato
    Di daniel84 nel forum Domande su Excel VBA e MACRO
    Risposte: 4
    Ultimo Messaggio: 08/12/15, 19:45

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •