| | 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 | |
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 | |
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 | |
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 | |
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 | |
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 | |
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 | |
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
Ciao
|
|
|