Salva dati su foglio diverso

Hai un problema con Excel?

Nuova discussione

Salva dati su foglio diverso
di Jack63 (utente non iscritto) data: 31/08/2014 12:29:38
in una discussuone su questo sito ho trovato un codice per salvare dati su un foglio di lavoro esterno, molto utile solo che per adattarlo alle mie esigenze dovrei apportare una modifica, ma non sò come fare dove devo copiare i dati le celle sono le seguenti B22:B26 mentre
nel file dove devo salvati i dati le celle non sono le seguenti,
dalla della A23 in giù
A23:B23,D23,F24,H24 mentre i nomi dei fogli rimangono invariati spero che qualcuno mi possa dare una mano grazie!
Allego il codice

Sub a2()
Sheets("Foglio1").Select
LR = Cells(Rows.Count, "A").End(xlUp).Row
FName = Sheets("Comandi").Range("B3") 'Percorso del file
Foglio = Sheets("Comandi").Range("C3") 'Nome del file dove salvare i dati
Range("A6:I" & LR).Copy
Application.DisplayAlerts = False
Set wbdest = Workbooks.Open(FName)
LR = wbdest.Sheets(Foglio).Cells(Rows.Count, "A").End(xlUp).Row + 1
wbdest.Sheets(Foglio).Range("A" & LR).PasteSpecial 'Incolla i dati
Application.CutCopyMode = False
wbdest.Close True
Application.DisplayAlerts = True
End Sub

di lepat (utente non iscritto) data: 31/08/2014 14:04:11
prova questa modifica

Sub a2()
Sheets("Foglio1").Select
FName = Sheets("Comandi").Range("B3") 'Percorso del file
Foglio = Sheets("Comandi").Range("C3") 'Nome del file dove salvare i dati
Range("B22:B26").Copy
Application.DisplayAlerts = False
Set wbdest = Workbooks.Open(FName)
wbdest.Sheets(Foglio).Range("A23").PasteSpecial 'Incolla i dati
Application.CutCopyMode = False
wbdest.Close True
Application.DisplayAlerts = True
End Sub

di Jack63 (utente non iscritto) data: 31/08/2014 19:10:40
Grazie per aver considerato la mia richiesta, il problema e sul foglio dove si devono incollare i dati perchè le celle non sono consecutive esempio
cella A23:B23 incolla valori, mentre nella cella C23 non si devono inserire valori, cella D23,F24 incolla valori, cella G24 non si devono incollare valori, H24 incolla valori
spero che sia possibile!
di lepat (utente non iscritto) data: 31/08/2014 20:14:38
allega un file di esempio con i dati ed il risultato desiderato
di Jack63 (utente non iscritto) data: 01/09/2014 16:52:07
Cia lepat allego un file di esempio con i dati e cercherò di spigare il risultato da ottenere,
il file 1 Gestione contiene di dati da copiare, i dati da copiare si trovano:

Prima cella che contiene i dati da copiare A6
colonne A "Data"
colonne D "Totali 1"
colonne G "Totali 2"
colonne J "Totali 3"

I dati copiati vanno incollati nel file di nome 1 Archivio nelle seguenti colonne:

Prima cella vuota dove incollare i dati A7
colonne A "Data"
colonne B "Totali 1"
colonne D "Totali 2"
colonne F "Totali 3"

Allego i due file di esempio
di Jack63 (utente non iscritto) data: 01/09/2014 20:36:26
Salve qualcuno mi può dare una mano a risolvere il problema del copia e incolla dati

di lepat (utente non iscritto) data: 01/09/2014 21:07:35
elimina il modulo2 e prova questa

Sub a2()
Set sh1 = ThisWorkbook.Sheets("Foglio1")
sh1.Select
LR = Cells(Rows.Count, "A").End(xlUp).Row
FName = Sheets("Comandi").Range("B3") 'Percorso del file
Foglio = Sheets("Comandi").Range("C3") 'Nome del file dove salvare i dati

'Application.DisplayAlerts = False
Set wbdest = Workbooks.Open(FName)
LR1 = wbdest.Sheets(Foglio).Cells(Rows.Count, "A").End(xlUp).Row + 1
sh1.Range("A6:A" & LR).Copy
wbdest.Sheets(Foglio).Range("A" & LR1).PasteSpecial xlValues
sh1.Range("D6:D" & LR).Copy
wbdest.Sheets(Foglio).Range("B" & LR1).PasteSpecial xlValues
sh1.Range("G6:G" & LR).Copy
wbdest.Sheets(Foglio).Range("D" & LR1).PasteSpecial xlValues
sh1.Range("J6:J" & LR).Copy
wbdest.Sheets(Foglio).Range("F" & LR1).PasteSpecial xlValues

Application.CutCopyMode = False
wbdest.Close True
Application.DisplayAlerts = True
End Sub

di Jack63 (utente non iscritto) data: 01/09/2014 21:36:20
funziona l' unica cosa se è possibile nascondere il foglio 1 Archivio quando copia i dati, non visualizzarlo a video mentre lavora
di Jack63 (utente non iscritto) data: 02/09/2014 00:02:37
sono riuscito a risolvere il problema di nascondere il foglio archivio mentre lavora con Application.ScreenUpdating = False
però rimane un problema che non riesco a risolvere mi servirebbe un controllo sulla data, praticamente se la data risulta già presente sul foglio 1 Archivio, un messaggio mi deve avvisare se voglio salvare i dati oppure no, spero che sia realizzabile? Grazie ancora
di Jack63 (utente non iscritto) data: 02/09/2014 12:39:39
Salve qualcuno mi può aiutare ad inserire un controllo sulla data nel codice di lepat , praticamente se la data risulta già presente sul foglio "1 Archivio", un messaggio tramite un MsgBox mi avvisa che i dati sono già presente e se voglio risalvare i dati un altra volta "Si o No"

di Raffaele_53 (utente non iscritto) data: 02/09/2014 17:02:46
Da provare

Option Explicit
Sub a2()
Dim sh1 As Worksheet: Set sh1 = Worksheets("Foglio1")
Dim wbdest As Workbook
Dim LR As Long, Lr1 As Long, R As Long, X As Long
Dim FName As String, Foglio As String
Dim Risposta As Integer, RigaA As Object

sh1.Select
LR = Cells(Rows.Count, "A").End(xlUp).Row
FName = Sheets("Comandi").Range("B3") 'Percorso del file
Foglio = Sheets("Comandi").Range("C3") 'Nome del file dove salvare i dati

Set wbdest = Workbooks.Open(FName)
Lr1 = wbdest.Sheets(Foglio).Cells(Rows.Count, "A").End(xlUp).Row + 1
For X = 6 To LR
    Set RigaA = wbdest.Sheets(Foglio).Range(wbdest.Sheets(Foglio).Cells(6, 1), wbdest.Sheets(Foglio).Cells(Lr1, 1)).Find(sh1.Cells(X, 1), LookIn:=xlValues, LookAt:=xlWhole)
        If RigaA Is Nothing Then
            wbdest.Sheets(Foglio).Cells(Lr1, 1) = sh1.Cells(X, 1).Value
            wbdest.Sheets(Foglio).Cells(Lr1, 2) = sh1.Cells(X, 4).Value
            wbdest.Sheets(Foglio).Cells(Lr1, 4) = sh1.Cells(X, 7).Value
            wbdest.Sheets(Foglio).Cells(Lr1, 6) = sh1.Cells(X, 10).Value
            Lr1 = Lr1 + 1
        Else
            R = RigaA.Row
            Risposta = MsgBox(prompt:="DATA già presente. Cosa copiare i dati?", Buttons:=vbYesNo)
            'avendo trovato la data li sovvrascrive
            If Risposta = vbYes Then
                wbdest.Sheets(Foglio).Cells(R, 1) = sh1.Cells(X, 1).Value
                wbdest.Sheets(Foglio).Cells(R, 2) = sh1.Cells(X, 4).Value
                wbdest.Sheets(Foglio).Cells(R, 4) = sh1.Cells(X, 7).Value
                wbdest.Sheets(Foglio).Cells(R, 6) = sh1.Cells(X, 10).Value
            End If
      End If
Next X
wbdest.Close True
Application.DisplayAlerts = True
Set wbdest = Nothing
Set sh1 = Nothing
End Sub

di Jack63 (utente non iscritto) data: 02/09/2014 17:54:51
Ciao Raffaele_53 sto controllando il codice sembra che funziona abbastanza bene, non essendo esperto di Vba devo rivolgerti delle domande
se i dati sono già presenti ed io confermo con si verranno sovrascritti e può andar bene però come mai devo confermare lo stesso messaggio ben tre volte, la stessa cosa se gli dico nò?
di Raffaele_53 (utente non iscritto) data: 02/09/2014 19:35:26
>>>inserire un controllo sulla data

Se hai 3 record con date differenti, il codice controlla data x data se la trova appare il messaggio.
La cosa più impotante da scrivere nel post dell'uso che si vuole fare (si possono trovare soluzioni alternative).Ex
Aggiungo delle date nuove (in archivio non esistono e verrano scritte senza Msgbox), però se le riscrivi nuovamente per bisogno/errore. Ad ogni data chiede cosa fare. Modifico due righe, la prima per errore mio d'averla cancellata, la seconda per farTi capire meglio cosa stai per copiare.

2° la metto qui perchè non riesco a farla andare a capo
Risposta = MsgBox(prompt:="DATA già presente. Copiare i dati?" & vbCrLf & wbdest.Sheets(Foglio).Cells(R, 2) & " ---> " & sh1.Cells(X, 4).Value & vbCrLf & wbdest.Sheets(Foglio).Cells(R, 4) & " ---> " & sh1.Cells(X, 7).Value & vbCrLf & wbdest.Sheets(Foglio).Cells(R, 6) & " ---> " & sh1.Cells(X, 10).Value, Buttons:=vbYesNo)

1° aggiungi la riga in mezzo
Next X Application.DisplayAlerts = False wbdest.Close True
di Jack63 (utente non iscritto) data: 02/09/2014 19:47:50
Scusami Raffaele_53 ho fatto un po di casino con la spiegazione iniziale, in realtà ogni volta che archivio i dati sono con la stessa data perchè vengono archiviati ogni giorno, poi posso apportare delle modifiche e risalvare i dati, oppure inavvertitamente potrei cliccare il pulsante salva, per questo serve il messaggio..
Mi devi perdonare purtroppo ho fatto un pò di confusione.
Spero che mi puoi aiutare ad aggiustare il codice grazie tutto e scusa per il casino

di Raffaele_53 (utente non iscritto) data: 02/09/2014 21:41:33
>>>in realtà ogni volta che archivio i dati sono con la stessa data
In questo caso devi solo controllare se gli importi sono uguali/differenti per quella data

>>> oppure inavvertitamente potrei cliccare il pulsante salva
Questa non l'ho capita

Questo codice cerca la data (che deve essere univoca nel foglio dell'archivio).NB -->*
Verifica se i tre valori sono differenti (si/no)
Si appare il msgbox e li scrive
No non fa nulla, va avanti.
-----
Non trova la data scrive i dati senza msgbox
-----
NB -->* ci metto un controllo per elimare duplicati di date, perchè in caso contrario va tutto in tilt

Option Explicit
Sub a2()
Dim sh1 As Worksheet: Set sh1 = Worksheets("Foglio1")
Dim wbdest As Workbook
Dim LR As Long, Lr1 As Long, R As Long, X As Long
Dim FName As String, Foglio As String
Dim Risposta As Integer, RigaA As Object

sh1.Select
LR = Cells(Rows.Count, "A").End(xlUp).Row
FName = Sheets("Comandi").Range("B3") 'Percorso del file
Foglio = Sheets("Comandi").Range("C3") 'Nome del file dove salvare i dati

Set wbdest = Workbooks.Open(FName)
Lr1 = wbdest.Sheets(Foglio).Cells(Rows.Count, "A").End(xlUp).Row + 1
    wbdest.Sheets(Foglio).Range("A6:G" & Lr1).RemoveDuplicates Columns:=1, Header:=xlYes
For X = 6 To LR
    Set RigaA = wbdest.Sheets(Foglio).Range(wbdest.Sheets(Foglio).Cells(6, 1), wbdest.Sheets(Foglio).Cells(Lr1, 1)).Find(sh1.Cells(X, 1), LookIn:=xlValues, LookAt:=xlWhole)
        If RigaA Is Nothing Then
            wbdest.Sheets(Foglio).Cells(Lr1, 1) = sh1.Cells(X, 1).Value
            wbdest.Sheets(Foglio).Cells(Lr1, 2) = sh1.Cells(X, 4).Value
            wbdest.Sheets(Foglio).Cells(Lr1, 4) = sh1.Cells(X, 7).Value
            wbdest.Sheets(Foglio).Cells(Lr1, 6) = sh1.Cells(X, 10).Value
            Lr1 = Lr1 + 1
        Else
            R = RigaA.Row
If wbdest.Sheets(Foglio).Cells(R, 2) <> sh1.Cells(X, 4).Value Or wbdest.Sheets(Foglio).Cells(R, 4) <> sh1.Cells(X, 7).Value Or wbdest.Sheets(Foglio).Cells(R, 6) <> sh1.Cells(X, 10).Value Then
Risposta = MsgBox(prompt:="DATA già presente. Copiare i dati?" & vbCrLf & wbdest.Sheets(Foglio).Cells(R, 2) & " ---> " & sh1.Cells(X, 4).Value & vbCrLf & wbdest.Sheets(Foglio).Cells(R, 4) & " ---> " & sh1.Cells(X, 7).Value & vbCrLf & wbdest.Sheets(Foglio).Cells(R, 6) & " ---> " & sh1.Cells(X, 10).Value, Buttons:=vbYesNo)             'avendo trovato la data li sovvrascrive
            If Risposta = vbYes Then
                wbdest.Sheets(Foglio).Cells(R, 1) = sh1.Cells(X, 1).Value
                wbdest.Sheets(Foglio).Cells(R, 2) = sh1.Cells(X, 4).Value
                wbdest.Sheets(Foglio).Cells(R, 4) = sh1.Cells(X, 7).Value
                wbdest.Sheets(Foglio).Cells(R, 6) = sh1.Cells(X, 10).Value
            End If
End If
      End If
Next X
Application.DisplayAlerts = False
wbdest.Close True
Application.DisplayAlerts = True
Set wbdest = Nothing
Set sh1 = Nothing
End Sub

di Jack63 (utente non iscritto) data: 02/09/2014 22:52:12
Molto meglio la soluzione attuale perche il messaggio mi fa vedere i numeri archiviati e da archiviare, è possibile a fianco ai numeri visualizzare anche la data in questione?
di raffaele_53 (utente non iscritto) data: 02/09/2014 23:10:43
Risposta = MsgBox(prompt:="DATA già presente. Copiare i dati?" & vbCrLf & sh1.Cells(X, 1).Value & vbCrLf & wbdest.Sheets(Foglio).Cells(R, 2) & " ---> " & sh1.Cells(X, 4).Value & vbCrLf & wbdest.Sheets(Foglio).Cells(R, 4) & " ---> " & sh1.Cells(X, 7).Value & vbCrLf & wbdest.Sheets(Foglio).Cells(R, 6) & " ---> " & sh1.Cells(X, 10).Value, Buttons:=vbYesNo)
di Jack63 (utente non iscritto) data: 03/09/2014 00:19:02
funziona tutto a meraviglia, ultima modifica se possibile cambiare la Capition della Msgbox, adesso viene visualizzato Microsoft Excel potrei cambiarlo con AVVISO oppure con Attenzione L'operazione modifica i dati!
di Jack63 (utente non iscritto) data: 03/09/2014 20:22:35
come posso cambiare la Capition della Msgbox nel codice di Raffaele_53, qualcuno mi può aiutare grazie
di Jack663 (utente non iscritto) data: 04/09/2014 17:02:38
Risolto!

Vuoi Approfondire?