Pagina precedente | 1 | Pagina successiva
Vota | Stampa | Notifica email    
Autore

Copiare dati su fogli specifici di una cartella

Ultimo Aggiornamento: 14/10/2020 17:07
Post: 37
Registrato il: 10/09/2017
Città: ANNONE VENETO
Età: 59
Utente Junior
2007
OFFLINE
06/10/2020 19:58

Un saluto a tutti

Ho realizzato una macro che copia i valori di alcune celle da un singolo foglio(chiamato A) di una cartella ad altre celle che si trovano in un'altra cartella chiamata B), formata da 52 fogli, corrispondenti alle settimane.
La macro funziona ed è tutto è ok.
Vorrei però automatizzare la procedura in quanto attualmente, prima di attivare la macro, devo aprire la cartella di destinazione B (formata da 52 fogli) sul foglio corrispondente alla settimana attuale e poi lancio l'esecuzione della macro.
Se apro la cartella B su un foglio di una settimana errata la macro , pur funzionando, esegue le operazioni sul foglio errato.
La mia domanda è la seguente:
è possibile aggiungere dei comandi che prima di attivare la macro permettano di inserire in una finestra il numero del foglio dove trasferire i dati ?
Dovrebbe essere un'istruzione VBA tipo "Sheets(foglio).Activate" ma non ho trovato esempi validi.
Credo sia opportuno inserire un controllo in modo che il numero del foglio sia compreso tra 1 e 52
Allego il foglio B dove ho simulato per comodità solo tre fogli
Il foglio B è un semplice foglio di Excel con celle numeriche
Chiedo il vostro aiuto
Grazie a tutti per le risposte
Ciao
06/10/2020 22:59

Se il file di destinazione è sempre lo stesso. OK (oppure ricerca un file)
Di norma la macro apre il file predistinato "X" ed è (attivo)
A questo punto una inputbox "inserisci numero da 1 a 52"
y = inputbox (foglio)
Sheets(y).Activate
……copia/incolla
Quì, preferisco far distinzione tra files (File1 copia in File2) o (File2 copia in File1) e uso le variabili…
Il Codice dov'è?
Post: 37
Registrato il: 10/09/2017
Città: ANNONE VENETO
Età: 59
Utente Junior
2007
OFFLINE
07/10/2020 14:57

Re:
ABCDEF@Excel, 06/10/2020 22:59:

Se il file di destinazione è sempre lo stesso. OK (oppure ricerca un file)
Di norma la macro apre il file predistinato "X" ed è (attivo)
A questo punto una inputbox "inserisci numero da 1 a 52"
y = inputbox (foglio)
Sheets(y).Activate
……copia/incolla
Quì, preferisco far distinzione tra files (File1 copia in File2) o (File2 copia in File1) e uso le variabili…
Il Codice dov'è?



Grazie per la risposta
Allego la bozza del codice
Preciso che i due file si trovano obbligatoriamente sul Desktop

Il trasferimento dei dati avviene in via univoca dal foglio A.xls al foglio b.xls

L'aggiunta che vorrei inserire dovrebbe, a partire dal foglio A.xls aperto:
1) chiedere in quale foglio [W(1), W(2)....W(n) ] della cartella B.xls trasferire i dati
2) aprire la cartella B.xls nel foglio specificato

Poi il codice che ho preparato trasferirà i dati e farà le altre operazioni (salva e chiude il file e lo spedisce per mail - sto completando ora queste due fasi)

Se riesci a scrivere le righe di codice per le operazioni 1 e 2 sarei felice di apprendere nuove procedure

Grazie


08/10/2020 12:58

Ammettiamo che il file (B.xls) sia un Master creato per inviare mail (dato che usi 2007, non vedo il motivo che non sia "B.xlsx")

Tu scrivi...1) chiedere in quale foglio [W(1), W(2)....W(n)
Scusami, mà non dovrebbe essere da "quale foglio" trasferire i dati in B.xls
Oppure devo (dal foglio attivo) copiare/incollare in B.xls. Se B ha diversi fogli dimmi il "nome" del foglio specifico?
[Modificato da ABCDEF@Excel 08/10/2020 13:14]
Post: 38
Registrato il: 10/09/2017
Città: ANNONE VENETO
Età: 59
Utente Junior
2007
OFFLINE
08/10/2020 14:35

Re:
ABCDEF@Excel, 08/10/2020 12:58:

Ammettiamo che il file (B.xls) sia un Master creato per inviare mail (dato che usi 2007, non vedo il motivo che non sia "B.xlsx")

Tu scrivi...1) chiedere in quale foglio [W(1), W(2)....W(n)
Scusami, mà non dovrebbe essere da "quale foglio" trasferire i dati in B.xls
Oppure devo (dal foglio attivo) copiare/incollare in B.xls. Se B ha diversi fogli dimmi il "nome" del foglio specifico?




Ciao
Mi sono spiegato male:
il foglio A.xls è il foglio di origine dal quale devo trasferire i dati

Il foglio B.xls è la destinazione; è formato da 52 fogli nominati singolarmente W(1),W(2) ecc. fino a W(52)

Praticamente è un archivio annuale

I dati devono , in sintesi, essere trasferiti dal foglio A.xls (aperto e presente sul desktop) verso, la chiamerei cartella, B.xls nel foglio che corrisponde al numero della settimana .

Pertanto la finestra mi dovrebbe chiedere (+\-):
in quale foglio (settimana) della cartella di destinazione B.xls vuoi copiare i dati ?

Se inserisco 24 significa che i dati da A devono essere copiati nel foglio W(24) della cartella B.xls

Spero di essere stato il più possibile preciso nella descrizione del problema

ti ringrazio per la collaborazione

Buona giornata
09/10/2020 08:08

Controlla se i fogli si chiamano Wspazio(numero)
Casomai togli lo spazio >>>W (<<< in Nome = "W (" & N & ")"
Option Explicit
Function wsExists(sFoglio As String) As Boolean
  wsExists = Not IsError(Evaluate("'" & sFoglio & "'!A1"))
End Function
Sub copia()
Dim wk1 As Workbook, wk2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Pat As String, Nome As String, N As Long
Pat = ThisWorkbook.Path
Set wk1 = ThisWorkbook
Set sh1 = wk1.Worksheets(1) 'meglio Set sh1 = Worksheets("nome del foglio") non credo si chiami... W(1)
    'Workbooks.Open Filename:=Pat & "\" & "xxxxx.xlsx" se fosse sempre lo stesso
    Nome = Application.GetOpenFilename("Tutti i files (*.*), *.*")
    If Nome <> "" Then Set wk2 = Workbooks.Open(Nome)
        N = InputBox("Digitare un numero da 1 a 52. Ex 1 oppure 2", , 0)
        Nome = "W (" & N & ")" ' hai scritto che si chiama Wspazio(numero)
        If wsExists(Nome) Then
            Set sh2 = wk2.Worksheets(Nome)
            sh2.Range("B7") = sh1.Range("B7") 'oppure sh2.cells(7,2)=sh2.cells(7,2)
            sh2.Range("D7") = sh1.Range("D7") 'oppure sh2.cells(7,4)=sh2.cells(7,4)
            sh2.Range("F7") = sh1.Range("F7") 'oppure sh2.cells(7,6)=sh2.cells(7,6)
            wk2.Save
            wk2.Close
        Else
            MsgBox "Non esiste il foglio " & Nome
        End If
Set sh1 = Nothing
Set sh2 = Nothing
Set wk1 = Nothing
Set wk2 = Nothing
End Sub
Post: 39
Registrato il: 10/09/2017
Città: ANNONE VENETO
Età: 59
Utente Junior
2007
OFFLINE
09/10/2020 23:02

Re:
ABCDEF@Excel, 09/10/2020 08:08:

Controlla se i fogli si chiamano Wspazio(numero)
Casomai togli lo spazio >>>W (<<< in Nome = "W (" & N & ")"
Option Explicit
Function wsExists(sFoglio As String) As Boolean
  wsExists = Not IsError(Evaluate("'" & sFoglio & "'!A1"))
End Function
Sub copia()
Dim wk1 As Workbook, wk2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Pat As String, Nome As String, N As Long
Pat = ThisWorkbook.Path
Set wk1 = ThisWorkbook
Set sh1 = wk1.Worksheets(1) 'meglio Set sh1 = Worksheets("nome del foglio") non credo si chiami... W(1)
    'Workbooks.Open Filename:=Pat & "\" & "xxxxx.xlsx" se fosse sempre lo stesso
    Nome = Application.GetOpenFilename("Tutti i files (*.*), *.*")
    If Nome <> "" Then Set wk2 = Workbooks.Open(Nome)
        N = InputBox("Digitare un numero da 1 a 52. Ex 1 oppure 2", , 0)
        Nome = "W (" & N & ")" ' hai scritto che si chiama Wspazio(numero)
        If wsExists(Nome) Then
            Set sh2 = wk2.Worksheets(Nome)
            sh2.Range("B7") = sh1.Range("B7") 'oppure sh2.cells(7,2)=sh2.cells(7,2)
            sh2.Range("D7") = sh1.Range("D7") 'oppure sh2.cells(7,4)=sh2.cells(7,4)
            sh2.Range("F7") = sh1.Range("F7") 'oppure sh2.cells(7,6)=sh2.cells(7,6)
            wk2.Save
            wk2.Close
        Else
            MsgBox "Non esiste il foglio " & Nome
        End If
Set sh1 = Nothing
Set sh2 = Nothing
Set wk1 = Nothing
Set wk2 = Nothing
End Sub



Ciao
Ho provato il codice ma non credo che questo rifletta il mio problema
Il foglio B.xls è formato da 52 fogli
Il codice dovrebbe aprire il file b.xls in uno dei 52 fogli indicati dall' inputbox e poi il mio codice trasferirebbe i dati.

Io manualmente faccio cosi:
apro il file b.xls;
mi posizione sul foglio relativo alla settimana che mi interessa;
poi apro il file A.xls;
attivo la macro;
i dati passano da A verso B
Chiudo A
Verifico se B.xls è ok e poi lo chiudo manualmente

Ti allego il file b.xls originale con i 52 fogli così come sono stati nominati

ps
Perchè pat punta sempre alla cartella XLSTART e non al Desktop ?
I due file li ho sul desktop
Per precisione il percorso è:

C:\Users\PC-NEMO\Desktop\A.xls
C:\Users\PC-NEMO\Desktop\B.xls

potrebbe cambiare solo il nome utente del percorso se lo installo in altro pc ma resterebbero entrambi sempre sul desktop che è il percorso predefinito

Allego il file B originale con i nomi corretti dei file

Grazie mille

10/10/2020 00:26

Non puoi chiudere A (è in esecuzione il VBA). Ho disabilitato la chiusura del Files B

Questo, Ti fà scegliere un file da aprire (Desktop e pure in altri PC)
Pat = Sarà la stessa cartella dove risiede questo file e non dovrebbe cercarlo in XLSTART?
Gli scrivi il "num" della settimana e lui copia/incolla sull'altro. Vedo che adesso ci sono 5 celle da copiare, hai un esempio sul VBA, se non riesci scrivi da quale cella copiare.
Post: 40
Registrato il: 10/09/2017
Città: ANNONE VENETO
Età: 59
Utente Junior
2007
OFFLINE
10/10/2020 19:01

Re:
ABCDEF@Excel, 10/10/2020 00:26:

Non puoi chiudere A (è in esecuzione il VBA). Ho disabilitato la chiusura del Files B

Questo, Ti fà scegliere un file da aprire (Desktop e pure in altri PC)
Pat = Sarà la stessa cartella dove risiede questo file e non dovrebbe cercarlo in XLSTART?
Gli scrivi il "num" della settimana e lui copia/incolla sull'altro. Vedo che adesso ci sono 5 celle da copiare, hai un esempio sul VBA, se non riesci scrivi da quale cella copiare.




Ho preparato i due file A e B in versione semi definitiva, nel senso che il file B ha i 52 fogli ma ho realizzato solo il primo

Ho inserito in questo fogliole indicazioni di dove vanno copiati i file da A

Poi preparerò gli altri 51 quando avrò impostato bene il primo

In A, per comodità , ho inserito sotto le celle dei dati che mi servono, le celle di destinazione in B

Chiedo scusa ma non ho ben capito come stai impostando la macro.

Io pensavo così:
creo la macro
la aggiungo a PERSONAL.XLSB
Poi di solito aggiungo un pulsante personalizzato alla barra multifunzione di excel

Apro il file A.xls

lancio la macro tramite il pulsante, e questa:

1) prepara i dati in A
2) mi deve chiedere in quale dei 52 fogli del file B.xls trasferirli
3) Esegue il trasferimento
4) Chiude e salva B
5) Chiude e salva A

Solo per precisare:
normalmente quando faccio questo, nella macro inserisco per ogni cella di destinazione il formato numerico in modo che la destinazione abbia comunque sempre la stessa formattazione .

Poi volevo chiedere se esiste un comando VBA che sia in grado di individuare il path del desktop indipendentemente dal pc dove gira la macro così da poterla trasferire senza ogni volta cambiare il percorso manualmente
10/10/2020 23:46

Se allegavi i file "zippati", il forum non cambiava i nomi dei files.

>>>Io pensavo così: creo la macro la aggiungo a PERSONAL.XLSB
Fai come desideri, io ragiono in modo diverso...e non lo farei.
Personal.xlsb? Non va bene in una cartella sul Desktop???
>>>Pat = ThisWorkbook.Path 'significa la "cartella" creata sul desktop
Perchè aprire Personal.xlsb e poi altri due files? Se lo devi spostare su altro PC devi modificargli il Pat?

Decomprimi questo "ZIP" sul desktop. Apri li files A.xls e premi il bottone AVVIA

Ps il foglio W(1) non aveva lo spazio dopo W
Pps. Non potendo riconoscere i NOMI, sono A.xls e B.xlsx (casomai cambia il B nel VBA)
>>> abbia comunque sempre la stessa formattazione
Si, se il foglio di destinazione è predisposto (oppure si deve modificare il VBA).
>>>VBA che sia in grado individuare il path del desktop
Il Pat lo puoi scrivere a mano, per W10... Pat = "C:\Users\NomeUtente\Desktop\"
11/10/2020 02:41

Toglimi una curiosita, hai il Personal.xlsb pieno di bottoni dove ognuno fà un determinato lavoro? Comunque sul mio PC-W10, tramite tre righe parto da C:\Users\xxxxx\AppData\Roaming\Microsoft\Excel\XLSTART e cercano sul Desktop.
Ho messo i files sul desktop, creato il Personal.xlsb in XLSTART, aggiunto un modulo col codice sotto (ALT+F11,avviato) perfettamente.
Option Explicit
Function wsExists(sFoglio As String) As Boolean
  wsExists = Not IsError(Evaluate("'" & sFoglio & "'!A1"))
End Function
Sub copia()
Dim wk1 As Workbook, wk2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Pat As String, Nome As String, N As Long
Pat = ThisWorkbook.Path
N = InStr(Pat, Environ("username"))
Nome = Left(Pat, N - 1) & Environ("username") & "\Desktop\A.xls" 'casomai cambiare nome files
Set wk1 = Workbooks.Open(Nome)
Nome = ActiveSheet.Name
Set sh1 = wk1.Sheets(Nome)
Nome = Left(Pat, N - 1) & Environ("username") & "\Desktop\B.xlsx" 'casomai cambiare nome files
Set wk2 = Workbooks.Open(Nome)
    N = InputBox("Digitare un numero da 1 a 52. Ex 1 oppure 2,3,4 ecc", , 0)
    Nome = "W (" & N & ")"
    If wsExists(Nome) Then
        Set sh2 = wk2.Worksheets(Nome)
        sh2.Range("B6") = sh1.Range("C2")
        sh2.Range("C6") = sh1.Range("D2")
        sh2.Range("D6") = sh1.Range("E2")
        sh2.Range("B9") = sh1.Range("F2")
        sh2.Range("D9") = sh1.Range("G2")
        sh2.Range("B10") = sh1.Range("H2")
        sh2.Range("D10") = sh1.Range("I2")
        sh2.Range("B11") = sh1.Range("J2")
        sh2.Range("D11") = sh1.Range("K2")
        sh2.Range("B12") = sh1.Range("L2")
        sh2.Range("D12") = sh1.Range("M2")
        wk2.Save
        wk2.Close
    Else
        MsgBox "Non esiste il foglio " & Nome
    End If
    wk1.Close
Set sh1 = Nothing
Set sh2 = Nothing
Set wk1 = Nothing
Set wk2 = Nothing
End Sub
Post: 41
Registrato il: 10/09/2017
Città: ANNONE VENETO
Età: 59
Utente Junior
2007
OFFLINE
11/10/2020 13:07

Re:
ABCDEF@Excel, 11/10/2020 02:41:

Toglimi una curiosita, hai il Personal.xlsb pieno di bottoni dove ognuno fà un determinato lavoro? Comunque sul mio PC-W10, tramite tre righe parto da C:\Users\xxxxx\AppData\Roaming\Microsoft\Excel\XLSTART e cercano sul Desktop.
Ho messo i files sul desktop, creato il Personal.xlsb in XLSTART, aggiunto un modulo col codice sotto (ALT+F11,avviato) perfettamente.
Option Explicit
Function wsExists(sFoglio As String) As Boolean
  wsExists = Not IsError(Evaluate("'" & sFoglio & "'!A1"))
End Function
Sub copia()
Dim wk1 As Workbook, wk2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Pat As String, Nome As String, N As Long
Pat = ThisWorkbook.Path
N = InStr(Pat, Environ("username"))
Nome = Left(Pat, N - 1) & Environ("username") & "\Desktop\A.xls" 'casomai cambiare nome files
Set wk1 = Workbooks.Open(Nome)
Nome = ActiveSheet.Name
Set sh1 = wk1.Sheets(Nome)
Nome = Left(Pat, N - 1) & Environ("username") & "\Desktop\B.xlsx" 'casomai cambiare nome files
Set wk2 = Workbooks.Open(Nome)
    N = InputBox("Digitare un numero da 1 a 52. Ex 1 oppure 2,3,4 ecc", , 0)
    Nome = "W (" & N & ")"
    If wsExists(Nome) Then
        Set sh2 = wk2.Worksheets(Nome)
        sh2.Range("B6") = sh1.Range("C2")
        sh2.Range("C6") = sh1.Range("D2")
        sh2.Range("D6") = sh1.Range("E2")
        sh2.Range("B9") = sh1.Range("F2")
        sh2.Range("D9") = sh1.Range("G2")
        sh2.Range("B10") = sh1.Range("H2")
        sh2.Range("D10") = sh1.Range("I2")
        sh2.Range("B11") = sh1.Range("J2")
        sh2.Range("D11") = sh1.Range("K2")
        sh2.Range("B12") = sh1.Range("L2")
        sh2.Range("D12") = sh1.Range("M2")
        wk2.Save
        wk2.Close
    Else
        MsgBox "Non esiste il foglio " & Nome
    End If
    wk1.Close
Set sh1 = Nothing
Set sh2 = Nothing
Set wk1 = Nothing
Set wk2 = Nothing
End Sub




Appena posso provo subito
Rispondo dal cell

Ti chiedo:

Fra le righe di codice che copiano i dati posso inserire la formattazione della cella di destinazione?

Tipo:

sh2.Range("B6").Select 'seleziono cella foglio B
Selection.NumberFormat = "#,##0.00" 'formatto cella
sh2.Range("B6") = sh1.Range("C2") 'copio dato

sh2.Range("c6").Select 'seleziono cella foglio B
Selection.NumberFormat = "0.00%" 'formatto cella
sh2.Range("C6") = sh1.Range("D2") 'copio dato

O sto facendo un'operazione che potrebbe creare problemi al codice?

In Personal ho diverse macro ognuna attivabile con il proprio pulsante su una scheda che ho creato nella barra multifunzionale.

Se ho capito inserisco il codice come una nuova macro e poi preparo il pulsante da inserei nella barra multifunzionale

Grazie ancora
11/10/2020 13:32

Ripeto sul mio funziona, sul Tuo non saprei (W10? forse si)
Basta inserire il codice in Personal.xlsb e creargli il bottone.

Una riga sola per ogni cella (copia e formatta).
Ex Destinazione = Format(origine,"?????")
sh2.Range("B6") = Format(sh1.Range("C2"), "#,###.00")
sh2.Range("C6") = Format(sh1.Range("D2"), "0.00%")
Post: 42
Registrato il: 10/09/2017
Città: ANNONE VENETO
Età: 59
Utente Junior
2007
OFFLINE
11/10/2020 14:24

Re:
ABCDEF@Excel, 11/10/2020 13:32:

Ripeto sul mio funziona, sul Tuo non saprei (W10? forse si)
Basta inserire il codice in Personal.xlsb e creargli il bottone.

Una riga sola per ogni cella (copia e formatta).
Ex Destinazione = Format(origine,"?????")
sh2.Range("B6") = Format(sh1.Range("C2"), "#,###.00")
sh2.Range("C6") = Format(sh1.Range("D2"), "0.00%")



ciao

Ti rispondo via cell

Grazie per la risposta per la formattazione
Non ho dubbi che la macro funzioni correttamente; non riesco a provarla perche mom ho il pc a portata di mano

Integro il codice con le varie formattazioni e poi attivo il pulsante

Ci sentiamo dopo il collaudo

Grazie ancora

Ciao

Post: 43
Registrato il: 10/09/2017
Città: ANNONE VENETO
Età: 59
Utente Junior
2007
OFFLINE
14/10/2020 17:07

Collaudo finale
Jacknemo, 11/10/2020 14:24:



ciao

Ti rispondo via cell

Grazie per la risposta per la formattazione
Non ho dubbi che la macro funzioni correttamente; non riesco a provarla perche mom ho il pc a portata di mano

Integro il codice con le varie formattazioni e poi attivo il pulsante

Ci sentiamo dopo il collaudo

Grazie ancora

Ciao




Il codice è perfetto
Ho inserito il mio per i calcoli e ora il trasferimento funziona perfettamente in modo automatico

Ti ringrazio per i preziosi suggerimenti e per la compilazione del codice [SM=x423017]

Ciao


Vota:
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 | Pagina successiva
Nuova Discussione
 | 
Rispondi
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 07:27. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com