Forum di Excel e VBA, per condividere esperienze e risolvere problemi su:
Excel, Word, Access, Power Point, Microsoft Office, macro, Visual Basic e Visual Studio.
creare form
- Hai un problema con Excel?
creare form
di luigi biasotto (utente non iscritto) data: 29/08/2016 09:57:22
Buon giorno a tutti, avrei un piccolo quesito da sottoporVi..............ogni giorno compilo una tabella dove ci sono dei nominativi di chi fa il lavoro e in corrispondenza segno anche per chi lo fanno es. ditta DHL, autista GIOVANNI, ha ritirato da ZANUSSI 3 eur da FIAT 7 bancali in data.....ecc. ecc. questa tabella la memorizzo in una cartella in PDF e contemporaneamente la cancello per preparare la maschera vuota per il gg dopo. Vorrei creare un form che mi dia la possibilità di filtrare i dati creati/memorizzati in una altra tabella e sapere in un range di una settimana /mese quante volte sono stato da ZANUSSI piu che da FIAT e chi e stato es. dalla data alla data vorrei sapere chi è andato ad esempio alla fiat, mi dovrebbe restituire (lista della ditta) + (lista degli autisti)+ date degli interventi
Spero di essermi spiegato bene e in attesa di ricevere vostre istruzioni saluto
luigi
di Vecchio Frac data: 29/08/2016 10:16:41
Risposta veloce, usa una tabella pivot che raggruppa rapidamente le informazioni e le sistema in una tabella facilmente consultabile.
di luigi (utente non iscritto) data: 30/08/2016 00:38:23
Buona sera Vecchio Frac, grazie per la risposta senzaltro sarà il modo migliore per estrapolare dei dati con tabelle PIVOT, pero i dati li devo prendere da una tabella che vado a creare man mano che compilo un forum vedi file allegato (foglio 1). I dati inseriti nel foglio1 tramite una macro (per il momento non la ho integrata con altre macro ) che la chiamo " archivia dati" funziona.
Funziona solo però su una sola riga e una sola ditta e la vedo abbastanza lunga ............DOMANDA
come posso scriverla per tutte le 10 ditte? e per tutti i 9 servizi? altra cosa mi dovrebbe copiare solo le celle che contengono dei valori o numerici o di testo insomma solo quello che scrivo nel forum.
Spero di essermi spiegato bene in attesa saluto.
luigi b.
Sub archiviaDati() ' ' archiviaDati Macro ' ' Range("K3,N3").Select Selection.Copy Sheets("Foglio2").Select Range("A1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveCell.Offset(0, 2).Range("A1").Select Sheets("Foglio1").Select Range("B6:B7").Select Application.CutCopyMode = False Selection.Copy Sheets("Foglio2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True ActiveCell.Offset(0, 2).Range("A1").Select Sheets("Foglio1").Select Range("B9:C9").Select Application.CutCopyMode = False Selection.Copy Sheets("Foglio2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("F10").Select ActiveCell.Offset(0, 1).Range("A1").Select End Sub
di luigi biasotto (utente non iscritto) data: 31/08/2016 07:57:21
buon giorno, forse per sbaglio qualcuno ha chiuso la mia discussione...............non la vedo piu rossa
grazie
luigi
di Vecchio Frac data: 31/08/2016 08:41:50
La discussione non è chiusa, è solo che non ci sono risposte dal giorno prima ^_^
I titoli delle discussioni vengono mostrati in rosso quando nella data odierna c'è almeno una risposta.
Significa che nessuno da ieri ti ha risposto... succede :)
di Albatros54 data: 31/08/2016 17:28:36
Incolla il codice sotto in un modulo VBA , è lo esegui, potrebbe essere la strada da percorrere.
Sub m() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim a As Range Dim righe As Long Dim c As Long Set sh1 = Sheets("foglio1") Set sh2 = Sheets("foglio2") With sh1 Set a = .Range("b9").CurrentRegion righe = a.Rows.Count For c = 1 To righe .Cells(3, 11).Copy sh2.Cells(c, 1) .Cells(3, 14).Copy sh2.Cells(c, 2) .Cells(6, 2).Copy sh2.Cells(c, 3) .Cells(7, 2).Copy sh2.Cells(c, 4) .Cells(c + 8, 2).Resize(, 2).Copy sh2.Cells(c, 5) Next End With End Sub
di luigi (utente non iscritto) data: 01/09/2016 02:23:14
Buona sera Albatros 54 vista l'ora buon giorno
Ho provato la tua macro funziona parzialmente mi spiego meglio:
Trasferisce i dati in maniera corretta nelle celle giuste ma con carattere diverso e anche il colore vorrei elimenarlo e come font diminuirlo se seleziono il tutto e faccio le correzzioni lo fa poi il successivo copia con prima.
poi , visto che sono 10 autisti vorrei inserire la tua macro (allinterno/sotto ) della mia (vedi mie macro A1 A2 A3 ecc. ( questa macro la ho fatta per dividere la cifra (numero) dalla lettera ) non posso mettere il numero dei bancali nella cella corrispondente al nome.... un poo coplicato ma e cosi..... cosi quando separo il numero dal nome mi copia direttamente il nome i bancali nel foglio 2
Spero di averti spiegato bene anche vista l'ora
garzie notte
luigi
di luigi biasotto (utente non iscritto) data: 01/09/2016 08:32:06
Scusata Albatro54, ho visto un'altra cosa che non va, quando esporti i dati da foglio 1 a foglio2 i dati dovrebbero mettersi in coda ai precedenti cosi da creare una tabella mensile di tutti i servizi fatti
saluti
di Albatros54 data: 01/09/2016 11:44:10
Sulla base di questo codice , puoi continuare tu.
Ciao
Sub m() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim a As Range Dim righe As Long Dim c As Long Dim ultima As Long Set sh1 = Sheets("foglio1") Set sh2 = Sheets("foglio4") Application.ScreenUpdating = False With sh1 Set a = .Range("b9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 2).Copy sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 2).Copy sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 2).Resize(, 2).Copy sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next Set a = .Range("E9").CurrentRegion righe = a.Rows.Count For c = 1 To righe .Cells(3, 11).Copy sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 5).Copy sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 5).Copy sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 5).Resize(, 2).Copy sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next End With Application.ScreenUpdating = True End Sub
di luigi biasotto (utente non iscritto) data: 01/09/2016 14:53:42
Buon giorno Albatros 54 ci siamo quasi...........la ho provata ma copia nel foglio 2 solo la prima riga dei servizi b9 e c9 e l'ultima riga e10 f11 ti allego file di prova.
altra cosa questa macro la ho memorizzata su un modulo nuovo ...........la posso scrivere (copiare) su un modulo che ho già associato un pulsante? nel caso specifico quello del PDF? altra cosa si puo scrivere alla fine un messaggio " fatto " o "copiato"?
Grazie
luigi
di Albatros54 data: 01/09/2016 15:13:46
Aggiungi la riga di codice come sotto, è saltata nel modo di incollare
Problemi ad incollare il codice
di Albatros54 data: 01/09/2016 15:15:53
Aggiungi la riga di codice come sotto, è saltata nel modo di incollare
Problemi ad incollare il codice
di Albatros54 data: 01/09/2016 15:19:24
Aggiungi la riga di codice come sotto, era saltata nel primo post
Sub salva() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim a As Range Dim righe As Long Dim c As Long Dim ultima As Long Set sh1 = Sheets("foglio1") Set sh2 = Sheets("foglio2") Application.ScreenUpdating = False With sh1 Set a = .Range("b9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 2).Copy 'ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 2).Copy ' autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 2).Resize(, 2).Copy ' n. pallette sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next Set a = .Range("E9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 <
di luigi biasotto (utente non iscritto) data: 01/09/2016 15:21:36
Velocissimo.............Albatro54 funziona tutto bene grazie bravo, ultima cosa come ti dicevo prima posso copiare la macro sul modulo dove e assegnato il pulsante PDF?
per il msgBox ho combinato
grazie
di Albatros54 data: 01/09/2016 15:27:48
Conviene sempre (opinione personale)scrive i codici in un modulo, perchè cosi sono visibili in tutto il progetto VBA, scrivendo il codice nel modulo del folgio,nel tuo caso la sub Pdf nel foglio1, questa è visibile solamente quando è seleziona il foglio( spero di non essermi sbagliato).
Ciao
di luigi biasotto (utente non iscritto) data: 01/09/2016 15:35:21
Ok ma allora devo creare un nuovo pulsante? e assegnarli la marco SALVA? come potrei in contemporanea cliccare il pulsante "archivia & salva" che fa gia delle operazioni ad attivare la macro salva che sarebbe quella nuova?
grazie
luigi
di Albatros54 data: 01/09/2016 15:41:55
sposta la macro PDF dal foglio1 in un modulo, nel tuocaso dove c'è la sub salva, nel codice della sub salva prima dell'ultima riga end sub , inserisci Call PDF, ora associa il pulsante alla sub Salva, automaticamente quando fai click sul pulsante lanci il codice salva e prima che la sub termini lancia la sub PDF automaticamente.
di luigi biasotto (utente non iscritto) data: 01/09/2016 16:14:50
Ho fatto come mi dicevi (forse ho commesso un errore) non funziona ho spostato tutto sul modulo 1 vedi file
di Albatros54 data: 01/09/2016 16:51:25
Prova il file che ti allego.
ciao
di luigi biasotto (utente non iscritto) data: 01/09/2016 17:03:40
ok ma non cancella
di luigi biasotto (utente non iscritto) data: 01/09/2016 17:12:53
scusa ma controllando meglio non copia tutto vedi allegato
di luigi biasotto (utente non iscritto) data: 01/09/2016 17:17:40
ok adesso copia tutto ma continua a non cancellare
di luigi biasotto (utente non iscritto) data: 02/09/2016 08:11:50
Buon giorno Albatros54 ho copiato ragruppato le due macro come mi hai detto tu ma fa solo il "copia " la cancellazione e il PDF non lo fa
Secondo me perchè ce un end a fine della macro "m" e un sub PDF non ce continuazione ho provato a togliere end e sub ma non funziona
Grazie
Sub m() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim a As Range Dim righe As Long Dim c As Long Dim ultima As Long Set sh1 = Sheets("foglio1") Set sh2 = Sheets("foglio2") Application.ScreenUpdating = False With sh1 Set a = .Range("b9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 2).Copy 'ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 2).Copy ' autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 2).Resize(, 2).Copy ' n. pallette sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next Set a = .Range("E9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 5).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 5).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 5).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next MsgBox "COPIATO SU FOGLIO2" End With Application.ScreenUpdating = True End Sub Sub salva() today = Now today = Cells(3, 1) & "_" & Cells(3, 11) & " _ " & Format(Date, "dd") & "." & Format(Date, "mm") & "." & Format(Date, "yy") & "." & Format(Time, "hhmmss") Nome = "C:UsersUtente.ASSERVICEDesktoparchivio RITIRI" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Nome & today & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:= _ True, IgnorePrintAreas:=False, OpenAfterPublish:=False Range("B6:B7,B9:C17,E6:E7,E9:F17,H6:H7,H9:I17,K6:K7,K9:L17,N6:N7,N9:O17,B21:o32") = c7 ' sicuro sino N39 Cells(3, 11) = Cells(3, 11) + 1 ' per aumentare Bordero MsgBox "PDF creato/salvato" Range("b6").Select ActiveWorkbook.Save Call PDF End Sub
di luigi biasotto (utente non iscritto) data: 02/09/2016 10:44:30
Buon giorno Albatros54 ho capito dove sbagliavo..............ho creato un pulsante da Controlli Axteves e ho copiato le mecro e funziona prima avevo un pulsante creato con Forme !!!!!
grazie
alle prossime
luigi
di luigi (utente non iscritto) data: 04/09/2016 12:00:30
Buon giorno aAlbatros54 come al salito grido vittoria e poi mi accorgo che non ho vinto......scusa ti spiego.......1° problema inserendo solo i dati sulla colonna "b" quando copia sul foglio2 mi copia ok i dati della colonna "b" ma anche le intestazioni "k3" e "n3" anche se nella colonna "e" non ce scritto nulla............
2° problema...... continuando con la scrittura del codice "b9" "e9" "h9" ecc quando vado a inserire i dati nella colonna "h" non mi copia i dati della colonna "h" sul foglio2
ti allego il codice
grazie
luigi biasotto
Sub m() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim a As Range Dim righe As Long Dim c As Long Dim ultima As Long Set sh1 = Sheets("foglio1") Set sh2 = Sheets("foglio2") Application.ScreenUpdating = False With sh1 Set a = .Range("b9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 2).Copy 'ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 2).Copy ' autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 2).Resize(, 2).Copy ' n. pallette sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next Set a = .Range("E9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 5).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 5).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 5).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next 'With sh1 Set a = .Range("H9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 8).Copy 'ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 8).Copy ' autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 8).Resize(, 2).Copy ' n. pallette sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False MsgBox "COPIATO SU FOGLIO2" End With Application.ScreenUpdating = True Call pdf End Sub Sub pdf() today = Now today = Cells(3, 1) & "_" & Cells(3, 11) & " _ " & Format(Date, "dd") & "." & Format(Date, "mm") & "." & Format(Date, "yy") & "." & Format(Time, "hhmmss") Nome = "C:UsershpDesktoparchivio RITIRI" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Nome & today & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:= _ True, IgnorePrintAreas:=False, OpenAfterPublish:=False Range("B6:B7,B9:C17,E6:E7,E9:F17,H6:H7,H9:I17,K6:K7,K9:L17,N6:N7,N9:O17,B21:o32") = c7 ' sicuro sino N39 Cells(3, 11) = Cells(3, 11) + 1 ' per aumentare Bordero MsgBox "PDF creato/salvato" Range("b6").Select ActiveWorkbook.Save End Sub
di Albatros54 data: 04/09/2016 17:32:34
sulla prima domanda , non riesco a capire, cerca di essere piu chiaro.
Nel codice alla riga "with sh1", riferita alla cella "H9" togli l'apice.
di luigi biasotto (utente non iscritto) data: 05/09/2016 08:38:03
Buon giorno Albatros54, non funziona, cerco di spiegarti meglio ti allego anche un file............. nella colonna b6 b7 e b9 vanno inseriti dei valori che tramite pulsante li devo copiare sul foglio2 in determinate celle, compreso la data e il numero di lista, la stessa cosa la deve fare quando compilo anche la colonna "e" stesse righe di "b" quando compilo la colonna "h" ecc. ecc .
Invece lui copia, ad esempio se compilo la colonna "b" solo la "b" copia tutte le sue celle giuste sul foglio2 in PIU' copia per altre 2 righe anche la data e il numero di lista vedi allegato.........
Ricapitolando...... se nella colonna "b" ci sono dei dati deve copiare Copire solo i dati dell B compreso naturalmente data e n. lista
e non le altre due righe
spero di averti spiegato bene
Saluti
di Albatros54 data: 05/09/2016 12:13:32
Scusa, il programma funziona alla grande, perchè se tu leggi il codice , lui che fa: selezione il foglio1 (sh1), a partire dalla cella "B9" seleziona tutte le celle con dei dati,conta le righe che compongono il range, pesca l'utima celle vuota del foglio2(sh2),inizia un ciclo for che copia nel foglio2(sh2)i dati,coem la data , il numero di bolla e i vari valori del range, una volta finito ,lo stesso ragionamento lo fa per la cella E2, pero trovando il range vuoto copia solo la data e il numero di bolla.
Se tu vuoi solamente copiare i dati di un range alla volta , e un altro discorso.
ciao
albatros54
di luigi biasotto (utente non iscritto) data: 05/09/2016 14:37:58
Ciao Albatros54, secondo me manca un "se" .....ok copia tutti i dati del range "B" sul foglio2 ma non dovrebbe copiare la seconda riga (solo la data e il numero di lista) sulla seconda riga del foglio2 ........ricapitolando .......copiare il range della colonna "B" compreso data e n.lista sul foglio2 ..... SE...... nel range delle colonne "E" "H" "K" ecc ecc NON ce nulla copiare SOLO "E" .
secondo me manca un "if"
grazie
luigi
di Albatros54 data: 05/09/2016 15:09:52
Cit..." SE...... nel range delle colonne "E" "H" "K" ecc ecc NON ce nulla copiare SOLO "E" . "
Se le celle "E","H" e "K" non contengono dati copia solo"E", e che cosa , se la cella"E9" è vuota?
di luigi biasotto (utente non iscritto) data: 05/09/2016 16:37:42
Scusami Albatro54, ti ho fatto un po di confusione ..............ho modificato la macro vedi allegato alcuni esempi
grazie ciao
Private Sub cmdSalva_Click() 'Sub m() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim a As Range Dim righe As Long Dim c As Long Dim ultima As Long Set sh1 = Sheets("foglio1") Set sh2 = Sheets("foglio2") Application.ScreenUpdating = False With sh1 Set a = .Range("b9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 2).Copy 'ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 2).Copy ' autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 2).Resize(, 2).Copy ' n. pallette sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False 'Next If Range("E9") = "" Then ultima = sc2 = "" Else Set a = .Range("E9").CurrentRegion righe = a.Rows.Count 'For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 5).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 5).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 5).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False End If If Range("h9") = "" Then ultima = sc2 = "" Else Set a = .Range("H9").CurrentRegion righe = a.Rows.Count 'For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 8).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 8).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 8).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False End If If Range("K9") = "" Then ultima = sc2 = "" Else Set a = .Range("K9").CurrentRegion righe = a.Rows.Count 'For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 11).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 11).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 11).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False End If If Range("N9") = "" Then ultima = sc2 = "" Else Set a = .Range("N9").CurrentRegion righe = a.Rows.Count 'For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 14).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 14).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 14).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False End If If Range("B24") = "" Then ultima = sc2 = "" Else Set a = .Range("B24").CurrentRegion righe = a.Rows.Count 'For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(21, 2).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(22, 2).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 23, 2).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False End If If Range("E24") = "" Then ultima = sc2 = "" Else Set a = .Range("E24").CurrentRegion righe = a.Rows.Count 'For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(21, 5).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(22, 5).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 23, 5).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False End If If Range("H24") = "" Then ultima = sc2 = "" Else Set a = .Range("H24").CurrentRegion righe = a.Rows.Count 'For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(21, 8).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(22, 8).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 23, 8).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False End If If Range("K24") = "" Then ultima = sc2 = "" Else Set a = .Range("K24").CurrentRegion righe = a.Rows.Count 'For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(21, 11).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(22, 11).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 23, 11).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False End If If Range("N24") = "" Then ultima = sc2 = "" Else Set a = .Range("N24").CurrentRegion righe = a.Rows.Count 'For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(21, 14).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(22, 14).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 23, 14).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False End If Next MsgBox "COPIATO SU FOGLIO2" End With Application.ScreenUpdating = True Call pdff End Sub Sub pdff() today = Now today = Cells(3, 1) & "_" & Cells(3, 11) & " _ " & Format(Date, "dd") & "." & Format(Date, "mm") & "." & Format(Date, "yy") & "." & Format(Time, "hhmmss") Nome = "C:UsersUtente.ASSERVICEDesktoparchivio RITIRI" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Nome & today & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:= _ True, IgnorePrintAreas:=False, OpenAfterPublish:=False Range("B6:B7,B9:C17,E6:E7,E9:F17,H6:H7,H9:I17,K6:K7,K9:L17,N6:N7,N9:O17,B21:o32") = c7 ' sicuro sino N39 Cells(3, 11) = Cells(3, 11) + 1 ' per aumentare Bordero MsgBox "PDF creato/salvato" Range("b6").Select ActiveWorkbook.Save End Sub
di Albatros54 data: 05/09/2016 16:45:47
If Range("N9") = "" Then
ultima = sc2 = ""
cosa fa questa riga di codice: se range("n9") è vuota ultima è uguale a sc2 che è uguale a stringa vuota, o deve uscire da Sub?
Non capisco.
di luigi biasotto (utente non iscritto) data: 05/09/2016 17:05:41
forse ho scritto male ......ma volevo dire : se nel range "n9" non ce nulla non scrivere nulla nel foglio2 nemmeno la data e il numero di lista
stesso principio per k9,h9,e9 ecc ecc
ciao
di Albatros54 data: 05/09/2016 18:32:59
Prova il codice sotto
Private Sub cmdSalva_Click() 'Sub m() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim a As Range Dim righe As Long Dim c As Long Dim ultima As Long Set sh1 = Sheets("foglio1") Set sh2 = Sheets("foglio2") Application.ScreenUpdating = False With sh1 Set a = .Range("b9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 2).Copy 'ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 2).Copy ' autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 2).Resize(, 2).Copy ' n. pallette sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next If Len(.Range("E9").Value) <> 0 Then Set a = .Range("E9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 5).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 5).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 5).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next End If If Len(.Range("H9").Value) <> 0 Then Set a = .Range("H9").CurrentRegion righe = a.Rows.Count For c = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 8).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 8).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 8).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next End If If Len(.Range("K9").Value) <> 0 Then Set a = .Range("K9").CurrentRegion righe = a.Rows.Count For t = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 11).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 11).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 11).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next End If If Len(.Range("N9").Value) <> 0 Then Set a = .Range("N9").CurrentRegion righe = a.Rows.Count For q = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(6, 14).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(7, 14).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 8, 14).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next End If If Len(.Range("B24").Value) <> 0 Then Set a = .Range("B24").CurrentRegion righe = a.Rows.Count For s = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(21, 2).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(22, 2).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 23, 2).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next End If If Len(.Range("E24").Value) <> 0 Then Set a = .Range("E24").CurrentRegion righe = a.Rows.Count For v = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(21, 5).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(22, 5).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 23, 5).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next End If If Len(.Range("H24").Value) <> 0 Then Set a = .Range("H24").CurrentRegion righe = a.Rows.Count For n = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(21, 8).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(22, 8).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 23, 8).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next End If If Len(.Range("K24").Value) <> 0 Then Set a = .Range("K24").CurrentRegion righe = a.Rows.Count For m = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(21, 11).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(22, 11).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 23, 11).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next End If If Len(.Range("N24").Value) <> 0 Then Set a = .Range("N24").CurrentRegion righe = a.Rows.Count For o = 1 To righe ultima = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(3, 11).Copy ' n. lista sh2.Cells(ultima, 1).PasteSpecial xlPasteValues .Cells(3, 14).Copy ' data sh2.Cells(ultima, 2).PasteSpecial xlPasteValues .Cells(21, 14).Copy ' ditta sh2.Cells(ultima, 3).PasteSpecial xlPasteValues .Cells(22, 14).Copy 'autista sh2.Cells(ultima, 4).PasteSpecial xlPasteValues .Cells(c + 23, 14).Resize(, 2).Copy ' n. palleta sh2.Cells(ultima, 5).PasteSpecial xlPasteValues Application.CutCopyMode = False Next End If MsgBox "COPIATO SU FOGLIO2" End With Application.ScreenUpdating = True Call pdff End Sub Sub pdff() today = Now today = Cells(3, 1) & "_" & Cells(3, 11) & " _ " & Format(Date, "dd") & "." & Format(Date, "mm") & "." & Format(Date, "yy") & "." & Format(Time, "hhmmss") Nome = "C:UsersUtente.ASSERVICEDesktoparchivio RITIRI" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Nome & today & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:= _ True, IgnorePrintAreas:=False, OpenAfterPublish:=False Range("B6:B7,B9:C17,E6:E7,E9:F17,H6:H7,H9:I17,K6:K7,K9:L17,N6:N7,N9:O17,B21:o32") = c7 ' sicuro sino N39 Cells(3, 11) = Cells(3, 11) + 1 ' per aumentare Bordero MsgBox "PDF creato/salvato" Range("b6").Select ActiveWorkbook.Save End Sub
di luigi (utente non iscritto) data: 05/09/2016 23:39:07
Ciao Albatros54, funziona parzialmente le prime due range vengono copiate sul foglio2 dalla terza in poi no!!
Mi spiego meglio se scrivo qualcosa sul Range "b" sul Range "E" e sul Range "h" ecce ecc. viene copiato solo il contenuto di "b" e "e" sul foglio2
saluti
luigi
di Albatros54 data: 06/09/2016 08:03:52
Ho modificato il codice postato prima, sostituiscilo è lo provi,credo che abbiamo raggiunto l'obbiettivo.
Ciao
di luigi biasotto (utente non iscritto) data: 06/09/2016 09:02:30
Grazie Albatros54 per il momento funziona la testero meglio
intanto grazie mille
luigi
di luigi biasotto (utente non iscritto) data: 07/09/2016 11:21:10
Buon giorno Albatros54 solo per dirti che funziona ho fatte delle piccole modifiche ma adesso funziona
Grazie 1000
luigi
di Albatros54 data: 07/09/2016 11:53:08
Se abbiamo risolto spunta
- Vuoi Approfondire?
