Risultati da 1 a 20 di 20

Discussione: Copiare con condizione



  1. #1
    L'avatar di G.Bove
    Clicca e Apri
    Data Registrazione
    Oct 2015
    Località
    Milano
    Età
    51
    Messaggi
    870
    Versione Office
    2010
    Likes ricevuti
    24
    Likes dati
    186

    Copiare con condizione

    Ciao a tutti,
    Aggiustamenti del file in sviluppo ( ultimo thread risolto:Creare bordi con VBA e altri aggiustamenti )

    https://www.dropbox.com/s/ovvbg2mux1...orum.xlsm?dl=0
    Nel compilare il formo del foglio "Anagrafica", vorrei tenere distinte le opzioni previste nella Combobox6 e precisamente:
    a) Se è presente SI -> nulla muta rispetto a quanto presente nella macro
    b) Se è presente SOMMINISTRATO ->
    b1) I dati NON vanno inseriti in "Anagrafica" ma in "Anagrafica(2)"
    b2) Il Cognome&Nome + data inizio e data scadenza NON vanno inseriti in "1_Formazione Sicurezza" ma in "1_Formaz Somm"

    Ho provato, tenuto conto dell'aiuto di Ges nel thread sopracitato,a sviluppare qualcosa partendo dal fondo (ossia richiesta b2) ma anche indentare come suggerito da Patelbnon riesco a capire l'errore di Debug:
    Codice: 
    'wks6 ______1_Formaz Somm_INIZIO
      
    With wks6
        uRiga6 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            For y = 1 To 21
                TextBoxy = ""
                ComboBoxy = ""
                    If ComboBox6 = "SOMMINISTRATO" Then
                        .Range("A" & uRiga1).Value = TextBox1 & " " & TextBox2
                        .Range("B" & uRiga1).Value = Format(TextBox15, "mm/dd/yyyy")
                        .Range("C" & uRiga1).Value = CDate(TextBox15) + 60  ' ossia TexBox15+60gg
                        .Range("U" & uRiga1) = Application.WorksheetFunction.Days360(Format(TextBox15, "mm/dd/yyyy"), Date)
                        End With
                End If
            Next
    End With
                
              
              
      
    MsgBox "Dato inserito correttamente!"
    
    Set wks2 = Nothing
    Set wks = Nothing
    Set wks1 = Nothing
    Set wks2 = Nothing
    Set wks3 = Nothing
    Set wks4 = Nothing
    Set wks5 = Nothing
    Set wks6 = Nothing
    
    End Sub
    Grazie in anticipo
    Gene

  2. #2

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7160
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2065
    Likes dati
    1301

    Re: Copiare con condizione

    Ciao Gene,
    correggo il tuo codice.
    Codice: 
    With wks6
        uRiga6 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            For y = 1 To 21
                TextBoxy = ""
                ComboBoxy = ""
            Next
                    If ComboBox6 = "SOMMINISTRATO" Then
                        .Range("A" & uRiga6).Value = TextBox1 & " " & TextBox2
                        .Range("B" & uRiga6).Value = Format(TextBox15, "mm/dd/yyyy")
                        .Range("C" & uRiga6).Value = CDate(TextBox15) + 60  ' ossia TexBox15+60gg
                        .Range("U" & uRiga6) = Application.WorksheetFunction.Days360(Format(TextBox15, "mm/dd/yyyy"), Date)
                    End If
    End With       
    ....
    .....
    P.S. - Ti dimentichi sempre di aggiornare uRiga!
    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 ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7160
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2065
    Likes dati
    1301

    Re: Copiare con condizione

    Citazione Originariamente Scritto da G.Bove Visualizza Messaggio
    ..
    Nel compilare il formo del foglio "Anagrafica", vorrei tenere distinte le opzioni previste nella Combobox6 e precisamente:
    a) Se è presente SI -> nulla muta rispetto a quanto presente nella macro
    b) Se è presente SOMMINISTRATO ->
    b1) I dati NON vanno inseriti in "Anagrafica" ma in "Anagrafica(2)"
    b2) Il Cognome&Nome + data inizio e data scadenza NON vanno inseriti in "1_Formazione Sicurezza" ma in "1_Formaz Somm"

    Rivedendo la richiesta aggiungo e modifico il seguente pezzo di codice:

    Codice: 
    ....
    uRiga = wks.Range("A" & Rows.Count).End(xlUp).Row + 1
    uRiga6 = wks6.Range("A" & Rows.Count).End(xlUp).Row + 1
    uRiga7 = wks7.Range("A" & Rows.Count).End(xlUp).Row + 1
            If ComboBox6 <> "SOMMINISTRATO" Then
      With wks
                  .Cells(3, 1) = 1
                  .Cells(uRiga, 1) =uRiga - 2
                  .Cells(uRiga, 2) = TextBox15 'data inizio
                  .Cells(uRiga, 3) = TextBox1 & " " & TextBox2 ' cognome + nome
                  .Cells(uRiga, 4) = TextBox1 'cognome
                  .Cells(uRiga, 5) = TextBox2 'nome
                  .Cells(uRiga, 6) = OptionButton1 'nuovo assunto
                  .Cells(uRiga, 7) = TextBox12 'data nascita
                  .Cells(uRiga, 8) = TextBox13 'luogo nascita
                  .Cells(uRiga, 9) = TextBox14 'codice fiscale
                  .Cells(uRiga, 10) = ComboBox7 'qualifica
                  .Cells(uRiga, 11) = ComboBox1 'stabilimento
                  .Cells(uRiga, 12) = ComboBox3 'ruolo aziendale
                  .Cells(uRiga, 13) = ComboBox4 'ruolo sicurezza
                  .Cells(uRiga, 14) = ComboBox5 'titolo di studio
                  .Cells(uRiga, 15) = ComboBox6 'in forza
    End With
        Else
    With wks7
                   .Cells(3, 1) = 1
                  .Cells(uRiga7, 1) = uRiga7 - 2
                   .Cells(uRiga7, 2) = TextBox15   'data inizio
                  .Cells(uRiga7, 3) = TextBox1 & " " & TextBox2   ' cognome + nome
                  .Cells(uRiga7, 4) = TextBox1   'cognome
                  .Cells(uRiga7, 5) = TextBox2   'nome
                  .Cells(uRiga7, 6) = OptionButton1   'nuovo assunto
                  .Cells(uRiga7, 7) = TextBox12   'data nascita
                  .Cells(uRiga7, 8) = TextBox13   'luogo nascita
                  .Cells(uRiga7, 9) = TextBox14   'codice fiscale
                  .Cells(uRiga7, 10) = ComboBox7   'qualifica
                  .Cells(uRiga7, 11) = ComboBox1   'stabilimento
                  .Cells(uRiga7, 12) = ComboBox3   'ruolo aziendale
                  .Cells(uRiga7, 13) = ComboBox4   'ruolo sicurezza
                  .Cells(uRiga7, 14) = ComboBox5   'titolo di studio
                  .Cells(uRiga7, 15) = ComboBox6   'in forza
        End With
        With wks6
                        .Range("A" & uRiga6).Value = TextBox1 & " " & TextBox2
                        .Range("B" & uRiga6).Value = Format(TextBox15, "mm/dd/yyyy")
                        .Range("C" & uRiga6).Value = CDate(TextBox15) + 60  ' ossia TexBox15+60gg
                        .Range("U" & uRiga6) = Application.WorksheetFunction.Days360(Format(TextBox15, "mm/dd/yyyy"), Date)
    End With
        End If
    ..
    File Allegati File Allegati
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  4. #4
    L'avatar di G.Bove
    Clicca e Apri
    Data Registrazione
    Oct 2015
    Località
    Milano
    Età
    51
    Messaggi
    870
    Versione Office
    2010
    Likes ricevuti
    24
    Likes dati
    186

    Re: Copiare con condizione

    Ciao Ges,
    non riesco a scaricalo, quando clicco:


    Gene

  5. #5

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7160
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2065
    Likes dati
    1301

    Re: Copiare con condizione

    Ciao gene, prova ora.
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  6. #6
    L'avatar di G.Bove
    Clicca e Apri
    Data Registrazione
    Oct 2015
    Località
    Milano
    Età
    51
    Messaggi
    870
    Versione Office
    2010
    Likes ricevuti
    24
    Likes dati
    186

    Re: Copiare con condizione

    OK.
    Studio e ti aggiorno.

    Gene

  7. #7

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7160
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2065
    Likes dati
    1301

    Re: Copiare con condizione

    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 G.Bove
    Clicca e Apri
    Data Registrazione
    Oct 2015
    Località
    Milano
    Età
    51
    Messaggi
    870
    Versione Office
    2010
    Likes ricevuti
    24
    Likes dati
    186

    Re: Copiare con condizione

    Ciao Ges,
    Funziona ma il codice inizia ad essere più difficile da leggere e comprendere, infatti mi sono reso conto di un'imprecisione nel dettagliare la richiesta ma non ho capito dove "toccare".
    ....
    b) Se è presente SOMMINISTRATO ->
    b1) I dati NON vanno inseriti in "Anagrafica" e neanche in "0_nuovo assunto" ma in "Anagrafica(2)"
    Gene

  9. #9
    L'avatar di ggratis
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Lecce - Pisa
    Età
    45
    Messaggi
    737
    Versione Office
    Excel 2010
    Likes ricevuti
    257
    Likes dati
    215

    Re: Copiare con condizione

    ...piccolo contributo off topic ad un lavoro che è abbondantemente avanti:
    all'apertura del file mi va in errore su questa riga di codice:
    Codice: 
    Option Explicit
    
    
    Private Sub Workbook_Open()
    Dim ur As Long, i As Long, testo1 As String, testo As String, risp As Integer
    Sheets("Dashboard").Select
    With Sheets("1_formazione Sicurezza")
    ...
    modificando così, dovrebbe risolversi, probabilmente per la presenza della specifica Option Explicit

    Codice: 
    Option Explicit
    
    
    Private Sub Workbook_Open()
    Dim ur As Long, i As Long, testo1 As String, testo As String, risp As Integer
    ThisWorkbook.Sheets("Dashboard").Select
    With Sheets("1_formazione Sicurezza")
    ...
    anche i link delle immaginette home non funziona, è linkato ad un foglio non più presente...
    nominando l'immaginetta con il foglio di destinazione si può usare la macro associata all'immaginetta... (a meno che non puntino ad un file esterno!)

    Codice: 
    Sub cambia_foglio()
    With Sheets(Application.Caller)
        .Visible = True
    'Sheets(ActiveSheet.Name).Visible = False 'xlVeryHidden
        .Activate
    End With
    End Sub
    saluti
    gg

  10. #10

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7160
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2065
    Likes dati
    1301

    Re: Copiare con condizione

    Citazione Originariamente Scritto da G.Bove Visualizza Messaggio
    Ciao Ges,
    Funziona ma il codice inizia ad essere più difficile da leggere e comprendere, infatti mi sono reso conto di un'imprecisione nel dettagliare la richiesta ma non ho capito dove "toccare".
    Gene
    Ok, sistemo questa richiesta e cerco di renderti il codice più leggibile.
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  11. #11

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7160
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2065
    Likes dati
    1301

    Re: Copiare con condizione

    Citazione Originariamente Scritto da ggratis Visualizza Messaggio
    ...piccolo contributo off topic ad un lavoro che è abbondantemente avanti:
    all'apertura del file mi va in errore su questa riga di codice:
    .
    ..
    anche i link delle immaginette home non funziona, è linkato ad un foglio non più presente...
    nominando l'immaginetta con il foglio di destinazione si può usare la macro associata all'immaginetta... (a meno che non puntino ad un file esterno!)
    ..
    Grazie Giuseppe, non mi ero curato delle immaginette, prima si vedevano.
    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 G.Bove
    Clicca e Apri
    Data Registrazione
    Oct 2015
    Località
    Milano
    Età
    51
    Messaggi
    870
    Versione Office
    2010
    Likes ricevuti
    24
    Likes dati
    186

    Re: Copiare con condizione

    Confermo. E' un problema che mi sarei posto dopo.
    Ma grazie a Giuseppe, provvedo immanentemente.
    Mentre non ho nessun errore all'apertura del file.

    Gene

  13. #13

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7160
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2065
    Likes dati
    1301

    Re: Copiare con condizione

    Ecco qui:
    Codice: 
    Private Sub Label21_Click() 'Caption= SALVA 1) Inserisce i dati nel Foglio "Anagrafica"; 2) Inserisce i dati nel Foglio "3_SqEmergenza" spuntando con X i vari addetti;
    '3) Svuota i campi della UserForm; 4) Inserisce i bordi nel Foglio "0_Nuovo assunto" e nel Foglio "3_SqEmergenza"
    
    
    Dim wks As Worksheet, wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
    Dim wks4 As Worksheet, wks5 As Worksheet, wks6 As Worksheet, wks7 As Worksheet
    Dim uRiga1 As Long, uRiga2 As Long, uRiga3 As Long, uRiga4 As Long, uRiga5 As Long, uRiga6 As Long, y As Integer
    
    
    Set wks = Sheets("Anagrafica")
    Set wks1 = Sheets("0_Nuovo assunto")
    Set wks2 = Sheets("3_SqEmergenza")
    Set wks3 = Sheets("1_Formazione Sicurezza")
    Set wks4 = Sheets("2_Aggiornamenti")
    Set wks5 = Sheets("4_Addestramento Specifico")
    Set wks6 = Sheets("1_Formaz Somm")
    Set wks7 = Sheets("Anagrafica (2)")
    
    
    uRiga = wks.Range("A" & Rows.Count).End(xlUp).Row + 1
    uRiga6 = wks6.Range("A" & Rows.Count).End(xlUp).Row + 1
    uRiga7 = wks7.Range("A" & Rows.Count).End(xlUp).Row + 1
            
      ''INSERIMENTO DATI
      
            If ComboBox6 <> "SOMMINISTRATO" Then 'SE E' DIVERSO DA SOMMINISTRATO
    With wks 'Foglio: Anagrafica
                  .Cells(3, 1) = 1
                  .Cells(uRiga, 1) = uRiga - 2
                  .Cells(uRiga, 2) = TextBox15 'data inizio
                  .Cells(uRiga, 3) = TextBox1 & " " & TextBox2 ' cognome + nome
                  .Cells(uRiga, 4) = TextBox1 'cognome
                  .Cells(uRiga, 5) = TextBox2 'nome
                  .Cells(uRiga, 6) = OptionButton1 'nuovo assunto
                  .Cells(uRiga, 7) = TextBox12 'data nascita
                  .Cells(uRiga, 8) = TextBox13 'luogo nascita
                  .Cells(uRiga, 9) = TextBox14 'codice fiscale
                  .Cells(uRiga, 10) = ComboBox7 'qualifica
                  .Cells(uRiga, 11) = ComboBox1 'stabilimento
                  .Cells(uRiga, 12) = ComboBox3 'ruolo aziendale
                  .Cells(uRiga, 13) = ComboBox4 'ruolo sicurezza
                  .Cells(uRiga, 14) = ComboBox5 'titolo di studio
                  .Cells(uRiga, 15) = ComboBox6 'in forza
    End With
    
    
    With wks1 'Foglio: 0_Nuovo assunto
    uRiga1 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
           .Range("A" & uRiga1).Value = TextBox1 & " " & TextBox2
           .Range("M" & uRiga1).Value = Format(TextBox15, "mm/dd/yyyy")
           .Range("N" & uRiga1).Value = CDate(TextBox15) + 60  ' ossia TexBox15+60gg
           .Range("O" & uRiga1) = Application.WorksheetFunction.Days360(Format(TextBox15, "mm/dd/yyyy"), Date)
                              
    End With
    
    
        Else ' DIVERSAMENTE (SE E' SOMMINISTRATO)
        
    With wks7 'Foglio: Anagrafica (2)
                   .Cells(3, 1) = 1
                  .Cells(uRiga7, 1) = uRiga7 - 2
                   .Cells(uRiga7, 2) = TextBox15   'data inizio
                  .Cells(uRiga7, 3) = TextBox1 & " " & TextBox2   ' cognome + nome
                  .Cells(uRiga7, 4) = TextBox1   'cognome
                  .Cells(uRiga7, 5) = TextBox2   'nome
                  .Cells(uRiga7, 6) = OptionButton1   'nuovo assunto
                  .Cells(uRiga7, 7) = TextBox12   'data nascita
                  .Cells(uRiga7, 8) = TextBox13   'luogo nascita
                  .Cells(uRiga7, 9) = TextBox14   'codice fiscale
                  .Cells(uRiga7, 10) = ComboBox7   'qualifica
                  .Cells(uRiga7, 11) = ComboBox1   'stabilimento
                  .Cells(uRiga7, 12) = ComboBox3   'ruolo aziendale
                  .Cells(uRiga7, 13) = ComboBox4   'ruolo sicurezza
                  .Cells(uRiga7, 14) = ComboBox5   'titolo di studio
                  .Cells(uRiga7, 15) = ComboBox6   'in forza
        End With
        
        With wks6 'Foglio: 1_Formaz Somm
                        .Range("A" & uRiga6).Value = TextBox1 & " " & TextBox2
                        .Range("B" & uRiga6).Value = Format(TextBox15, "mm/dd/yyyy")
                        .Range("C" & uRiga6).Value = CDate(TextBox15) + 60  ' ossia TexBox15+60gg
                        .Range("U" & uRiga6) = Application.WorksheetFunction.Days360(Format(TextBox15, "mm/dd/yyyy"), Date)
    End With
      
                
        End If
              
     
          With wks2 'Foglio: 3_SqEmergenza
        uRiga2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            If ComboBox4 = "RLS" Then
                .Cells(uRiga2, 1) = TextBox1 & " " & TextBox2
                .Cells(uRiga2, 2) = "X"
            ElseIf ComboBox4 = "Addetto alle Emergenze" Then
                .Cells(uRiga2, 1) = TextBox1 & " " & TextBox2
                .Cells(uRiga2, 3) = "X"
            ElseIf ComboBox4 = "Addetto Antincendio" Then
               .Cells(uRiga2, 1) = TextBox1 & " " & TextBox2
                .Cells(uRiga2, 4) = "X"
            ElseIf ComboBox4 = "Addetto I Soccorso" Then
                .Cells(uRiga2, 1) = TextBox1 & " " & TextBox2
                .Cells(uRiga2, 5) = "X"
            End If
        End With
                        
       
    
    
        '____________ CODICE INSERISCI BORDI
        
    With wks1 'Foglio: 0_Nuovo assunto
        uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
            For y = 7 To uRow  'ciclo che spazzola dalla riga 7 all'ultima piena
                If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                    With .Range("A7:O" & y).Borders  'stabilisce l'intervallo che va dalla cella A7 alla Cella O (numero di riga ultima cella piena)
                        .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                        .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                        .Weight = 2  'questa riga stabilisce lo spessore del bordo (1 è il più piccolo)
                    End With
                End If
            Next
    End With
    
    
    With wks2
        uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
            For y = 5 To uRow  'ciclo che spazzola dalla riga 5 all'ultima piena
                If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                    With .Range("A5:AA" & y).Borders  'stabilisce l'intervallo che va dalla cella A5 alla Cella AA (numero di riga ultima cella piena)
                        .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                        .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                        .Weight = 1  'questa riga stabilisce lo spessore del bordo (1 è il più piccolo)
                    End With
                End If
            Next
    End With
      
        '____________ CODICE ORDINE ALFABETICO
      
     uRow = wks2.Cells(Rows.Count, 1).End(xlUp).Row
         
         With wks2.Range("A5:AA" & uRow) 'Foglio: 3_SqEmergenza
             .Sort Key1:=wks2.Range("A5"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1
        End With
        
      'wks3 ______1_FormazioneSicurezza_importa dati
    With wks3
        uRiga3 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
           .Range("A" & uRiga3).Value = TextBox1 & " " & TextBox2
           .Range("B" & uRiga3).Value = CDate(TextBox15) + 60  ' ossia TexBox15+60gg
              For y = 1 To 28 'oppure basta 1 To 2 ?
                TextBoxy = ""
                ComboBoxy = ""
              Next
              End With
           
        '____ed inserisce i bordi
        
    With wks3 'Foglio: 1_Formazione Sicurezza
        uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
            For y = 7 To uRow  'ciclo che spazzola dalla riga 7 all'ultima piena
                If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                    With .Range("A7:AB" & y).Borders  'stabilisce l'intervallo che va dalla cella A7 alla Cella AB (numero di riga ultima cella piena)
                        .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                        .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                        .Weight = 2  'questa riga stabilisce lo spessore del bordo (1 è il più piccolo)
                    End With
                End If
            Next
    End With
      
      'wks3 ______1_FormazioneSicurezza_FINE
      
      'wks4 ______2_Aggiornamenti_importa dati
    With wks4 'Foglio: 2_Aggiornamenti
        uRiga4 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
           .Range("A" & uRiga4).Value = TextBox1 & " " & TextBox2
              For y = 1 To 28
                TextBoxy = ""
                ComboBoxy = ""
              Next
              End With
           
        '____ed inserisce i bordi
        
    With wks4 'Foglio: 2_Aggiornamenti
        uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
            For y = 5 To uRow  'ciclo che spazzola dalla riga 5 all'ultima piena
                If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                    With .Range("A5:AB" & y).Borders  'stabilisce l'intervallo che va dalla cella A5 alla Cella AB (numero di riga ultima cella piena)
                        .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                        .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                        .Weight = 2  'questa riga stabilisce lo spessore del bordo (1 è il più piccolo)
                    End With
                End If
            Next
    End With
      
      'wks4 ______2_Aggiornamenti__FINE
      
      'wks5 ______4_Addestramento Specifico_importa dati
    With wks5 'Foglio: 4_Addestramento Specifico
        uRiga5 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
           .Range("A" & uRiga5).Value = TextBox1 & " " & TextBox
    End With
           
        '____ed inserisce i bordi
        
    With wks5 ' Foglio: 4_Addestramento Specifico
        uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
            For y = 7 To uRow  'ciclo che spazzola dalla riga 7 all'ultima piena
                If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                    With .Range("A7:Z" & y).Borders  'stabilisce l'intervallo che va dalla cella A7 alla Cella Z (numero di riga ultima cella piena)
                        .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                        .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                        .Weight = 2  'questa riga stabilisce lo spessore del bordo (1 è il più piccolo)
                    End With
                End If
            Next
    End With
      
      'wks5 ______4_Addestramento Specifico__FINE
      
      
      For y = 1 To 21
                TextBoxy = ""
                ComboBoxy = ""
              Next y
              
        
    MsgBox "Dato inserito correttamente!"
    
    
    Set wks2 = Nothing
    Set wks = Nothing
    Set wks1 = Nothing
    Set wks2 = Nothing
    Set wks3 = Nothing
    Set wks4 = Nothing
    Set wks5 = Nothing
    Set wks6 = Nothing
    
    
    End Sub
    Fai qualche prova
    File Allegati File Allegati
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  14. #14
    L'avatar di G.Bove
    Clicca e Apri
    Data Registrazione
    Oct 2015
    Località
    Milano
    Età
    51
    Messaggi
    870
    Versione Office
    2010
    Likes ricevuti
    24
    Likes dati
    186

    Re: Copiare con condizione

    Ciao Ges,
    è giusto che alla fine della macro non vi sia il Set wks7 = Nothing e che Set wks2 = Nothing sia doppio ?
    La domanda è sicuramente stupida ma non ho ancora capito a cosa servono.

    Codice: 
    Set wks2 = Nothing
    Set wks = Nothing
    Set wks1 = Nothing
    Set wks2 = Nothing
    Set wks3 = Nothing
    Set wks4 = Nothing
    Set wks5 = Nothing
    Set wks6 = Nothing
    Gene

  15. #15

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7160
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2065
    Likes dati
    1301

    Re: Copiare con condizione

    No, è una mia svista .. sempre meglio "distruggere" l'oggetto!
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  16. #16
    L'avatar di G.Bove
    Clicca e Apri
    Data Registrazione
    Oct 2015
    Località
    Milano
    Età
    51
    Messaggi
    870
    Versione Office
    2010
    Likes ricevuti
    24
    Likes dati
    186

    Re: Copiare con condizione

    Ciao Ges,
    fatti vari test e sembra che l'unico inghippo sia che quando seleziono SOMMINISTRATO scriva in "1_Formaz Somm" -> CORRETTO ma anche in "1_Formazione Sicurezza" -> NON corretto.

    Gene

  17. #17

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7160
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2065
    Likes dati
    1301

    Re: Copiare con condizione

    Ciano Gene,
    risolviamo subito.

    Il codice è lungo perchè ci sono tante istruzioni ma è semplice.
    Si può dividere in tre parti:
    - la prima che sta tra If ComboBox6 <> "SOMMINISTRATO" Then ed ELSE
    - la seconda che sta tra ELSE e End If
    - la terza che sta oltre End If

    In pratica tutto quello che sta
    dopo
    If ComboBox6 <> "SOMMINISTRATO" Then
    e prima di ELSE viene messo nelle With .... che stanno sotto tale codice,
    mentre tutto quello che sta dopo
    ELSE
    viene messo nelle With che stanno sotto Else.

    Tutto quello che sta oltre tale istruzione (Quindi dopo End If) si attiva in qualsiasi caso, cioè è svincolato da questo codice.
    File Allegati File Allegati
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  18. I seguenti utenti hanno dato un "Like"


  19. #18
    L'avatar di ggratis
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Lecce - Pisa
    Età
    45
    Messaggi
    737
    Versione Office
    Excel 2010
    Likes ricevuti
    257
    Likes dati
    215

    Re: Copiare con condizione

    Citazione Originariamente Scritto da ggratis Visualizza Messaggio
    ...piccolo contributo off topic ad un lavoro che è abbondantemente avanti:
    all'apertura del file mi va in errore su questa riga di codice:
    ...l'errore si verifica alla prima apertura del file una volta scaricato da internet, poi (acconsentito all'apertura del file) il problema non si ripresenta più anche lasciando l'istruzione sheet("Dashboard").Select
    saluti
    gg

  20. #19
    L'avatar di G.Bove
    Clicca e Apri
    Data Registrazione
    Oct 2015
    Località
    Milano
    Età
    51
    Messaggi
    870
    Versione Office
    2010
    Likes ricevuti
    24
    Likes dati
    186

    Re: Copiare con condizione

    [RISOLTO]
    Ciao Ges,


    Gene

  21. #20
    L'avatar di ggratis
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Lecce - Pisa
    Età
    45
    Messaggi
    737
    Versione Office
    Excel 2010
    Likes ricevuti
    257
    Likes dati
    215

    Re: Copiare con condizione

    una possibile procedura per aggiornare il tasto elimina...

    ci sono delle incongruenze nei dati archiviati, per cui l'effetto in alcuni punti non è quello sperato ...ma con opportuni aggiustamenti anche sui dati archiviati dovrebbe funzionare...
    cancella tutti i nomi ripetuti...

    saluti
    gg

    Codice: 
    
    
    Private Sub Label38_Click()
    
    
    Dim wks As Worksheet, wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
    Dim wks4 As Worksheet, wks5 As Worksheet, wks6 As Worksheet, wks7 As Worksheet
    Dim uRiga As Long, uRiga1 As Long, uRiga2 As Long, uRiga3 As Long, uRiga4 As Long, uRiga5 As Long, uRiga6 As Long
    Dim nominativo As String
    Dim Cella As Range
    
    
    Set wks = Sheets("Anagrafica")
    Set wks1 = Sheets("0_Nuovo assunto")
    Set wks2 = Sheets("3_SqEmergenza")
    Set wks3 = Sheets("1_Formazione Sicurezza")
    Set wks4 = Sheets("2_Aggiornamenti")
    Set wks5 = Sheets("4_Addestramento Specifico")
    Set wks6 = Sheets("1_Formaz Somm")
    Set wks7 = Sheets("Anagrafica (2)")
    
    
    
    
    Dim Silinecek_Satir, i As Long
    Dim cevap As String
    
    
    If TextBox1 = "" Or TextBox2 = "" Then
    Call MsgBox("Selezionare il contatto da eliminare", vbInformation, "Avviso")
    Exit Sub
    End If
        If ListBox1.ListIndex >= 0 Then
            cevap = MsgBox("Il contatto verrà cancellato." _
            & vbCrLf & "Vuoi procedere?", vbYesNo, "Avviso")
            If cevap = vbYes Then
                
                nominativo = TextBox1 & " " & TextBox2
                '---------------------elimino nominativo del foglio "anagrafica"
                 With wks
                uRiga = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("C3:C" & uRiga)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                
               Call Aggiorna
               
                '---------------------elimino nominativo del foglio "0_Nuovo assunto"
                With wks1
                uRiga1 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga1)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "3_SqEmergenza"
                With wks2
                uRiga2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A5:A" & uRiga2)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "1_Formazione Sicurezza"
                With wks3
                uRiga3 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga3)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "2_Aggiornamenti"
                With wks4
                uRiga4 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A5:A" & uRiga4)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "4_Addestramento Specifico"
                With wks5
                uRiga5 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga5)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "1_Formaz Somm"
                With wks6
                uRiga6 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga6)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "Anagrafica (2)"
                With wks7
                uRiga7 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("C4:C" & uRiga7)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
            End If
        End If
     End Sub

  22. I seguenti utenti hanno dato un "Like"


Discussioni Simili

  1. [Risolto] Copiare in un altro foglio celle di una riga se si verifica una condizione
    Di sowhatt nel forum Domande su Excel VBA e MACRO
    Risposte: 4
    Ultimo Messaggio: 03/03/17, 14:05
  2. [Risolto] Copiare Dato da un foglio ad un altro con una determinata condizione
    Di Saku90 nel forum Domande su Excel in generale
    Risposte: 4
    Ultimo Messaggio: 18/01/17, 10:43
  3. [Risolto] Copiare con una condizione + presenza testo
    Di G.Bove nel forum Domande su Excel in generale
    Risposte: 10
    Ultimo Messaggio: 20/09/16, 19:14
  4. [Risolto] Copiare cella e intestazione se presente una condizione
    Di G.Bove nel forum Domande su Excel in generale
    Risposte: 11
    Ultimo Messaggio: 17/09/16, 14:41
  5. Copiare valora di una cella da un foglio all'altro con condizione
    Di danylele74 nel forum Domande su Excel in generale
    Risposte: 1
    Ultimo Messaggio: 09/06/16, 12:43

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
  •