Macro che copia risultati no

Hai un problema con Excel?

Nuova discussione

Macro che copia risultati no
di Elias (utente non iscritto) data: 26/05/2014 09:18:08
Buongiorno Ragazzi Ho una macro che mi copia i risultati "NO" dalla tabella presente in folgio1, nel foglio di lavoro risultati ( ma per un solo foglio di lavoro ). Avendo 4 fogli di lavoro, cioè in ogni foglio ho una tabella ( 4 tabelle in tutto ). come faccio a copiare i risultati "No" nelle tabelle presenti nei 4 fogli di lavoro nel foglio di lavoro risultati? vorrei che mi copia le tabelle con i risultati NO nel foglio di lavoro Risultati una sotto l'altra ( sono tabelle diverse ). Grazie in anticipo!

Option Explicit
Sub RISULTATO()

Dim Ncol As Integer
Ncol = ActiveSheet.Rows(9).Find(what:="DISPONIBILITA'").Column

Worksheets("RISULTATO").Range("a7").CurrentRegion.Clear
    
    With ActiveSheet.Range("$A$9")
    .AutoFilter field:=Ncol, Criteria1:="NO"
    .CurrentRegion.Copy Sheets("RISULTATO").Range("a7")
    .AutoFilter field:=Ncol
    End With
    Sheets("RISULTATO").Select

End Sub

di Mister_x (utente non iscritto) data: 26/05/2014 10:14:55
ciao

in questo caso sarebbe utile avere ha disposizione un tuo file completo di tutti i fogli e vedere come sono strutturati, si intende eleminare dati sensibili, ma lasciando quelli da copiare e dove copiarli,
quindi allega il tuo file cosi si puo' creare la sub() per fare questo

ciao
PS per allegare un file hai a disposizione il tasto in alto a destra nella discussione
di Elias (utente non iscritto) data: 26/05/2014 10:23:58
Ho allegato il file "ES."
di Mister_x (utente non iscritto) data: 26/05/2014 10:39:47
ciao

ho controllato il tuo file, ma per fare questo lavoro non serve nessuna sub() ma dei semplici collegamenti ai fogli interessati, vedi il tuo file con le modifiche che ho fatto alla celle della colonna E del foglio RISULTATO
per questi lavori non conviene scomodare il VBA ma utilizzare le funzioni di excel in quanto piu' maleabili a modifiche

ciao

di ELIAS (utente non iscritto) data: 26/05/2014 10:46:58
Non ci sono modifiche. non voglio che mi copia le tabelle intere ma vorrei che mi copia le tabelle solo con i risultati "NO" facendo un filtro nella riga inserendo quest'istruzione

Dim Ncol As Integer
Ncol = ActiveSheet.Rows(9).Find(what:="DISPONIBILITA'").Column

Worksheets("RISULTATO").Range("a7").CurrentRegion.Clear
    
    With ActiveSheet.Range("$A$9")
    .AutoFilter field:=Ncol, Criteria1:="NO"
    .CurrentRegion.Copy Sheets("RISULTATO").Range("a7")
    .AutoFilter field:=Ncol
    End With
    Sheets("RISULTATO").Select

di ELIAS (utente non iscritto) data: 26/05/2014 10:51:33
Vorrei mettere assieme le due istruzione. Cioè quella di sopra e questa qui presente. Ho provato ma sinceramente non so come fare visto che uso da poco excel e non sono tanto pratico e esperienza

Option Explicit

Sub Risultato()
  
  nf = ThisWorkbook.Sheets.Count
  Application.ScreenUpdating = False
  Sheets("Risultato").UsedRange.ClearContents
  For i = 1 To nf
    Sheets(i).Range("a1:iv5000").Copy Sheets("risultato").Cells(5000, 1).End(xlUp).Offset(1, 0)
    Application.CutCopyMode = False
  Next
  Application.ScreenUpdating = True
End Sub

di e (utente non iscritto) data: 26/05/2014 11:33:22
spero di essermi riuscito a spiegare!! Vorrei una macro con pulsante che mi copia le tabelle nei 4 fogli di lavoro solo con i risultati "NO" dentro il foglio di lavoro risultati
di ELIAS (utente non iscritto) data: 26/05/2014 14:25:45
Non posso usare quest'istruzione? ho provato a mettere sheets(i) al posto di activesheet ma purtroppo mi dice errore
Ncol = Sheets(i).Rows(13).Find(what:="Risultati").Column

di Mister_x (utente non iscritto) data: 26/05/2014 15:24:39
ciao

da mettere in un modulo e da provare se soddisfa le tue esigenze di riporto valori no in foglio risultato

ciao

'' da inserire in un Modulo
Option Explicit

Sub Copia_NO_Risultato()
Dim Foglio As Variant
Dim i As Long, o As Long, Nriga As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Nriga = 10
Sheets("RISULTATO").Select
Range("A9:E1000").ClearContents
For i = 1 To Sheets.Count
  Foglio = UCase(Sheets(i).Name)
  If Foglio <> "RISULTATO" Then
  Cells(Nriga - 1, "E") = UCase(Sheets(i).Name)
    For o = 10 To Sheets(i).Cells(Rows.Count, "E").End(xlUp).Row
      If Sheets(i).Cells(o, "E") = "NO" Then
        Cells(Nriga, "A") = Sheets(i).Cells(o, "A")
        Cells(Nriga, "B") = Sheets(i).Cells(o, "B")
        Cells(Nriga, "C") = Sheets(i).Cells(o, "C")
        Cells(Nriga, "D") = Sheets(i).Cells(o, "D")
        Cells(Nriga, "E") = Sheets(i).Cells(o, "E")
        Nriga = Nriga + 1
      End If
    Next o
    Nriga = Nriga + 6
  End If
 Next i
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

di ELIAS (utente non iscritto) data: 26/05/2014 15:34:13
funziona!! Ma mi copia solo i valori e non la tabella intera con i valori ed i titoli e gli sfondi.. come faccio?
di ELIAS (utente non iscritto) data: 26/05/2014 15:42:17
Vorrei che copiasse la tabella com'è con le righe con i risultati "NO". le colonne possono variare, funzionerà lo stesso? Grazie per la tua disponibilità per aiutarmi

di nichicanta data: 26/05/2014 16:02:31
prova quesat e dimmmi se va bene, l'ho adattata al tuo quesito, cambia la colon anche devi utilizzare per filtrare i dati di tutti ifogli cambiando il valore in quesat riga:Field:=4 ( il numero indica la colonna su cui applicare il filtro).
Ti saluto.

Sub m()
Dim nf As Long, i As Long 
  nf = ThisWorkbook.Sheets.Count
  Application.ScreenUpdating = False
  Sheets("RISULTATO").UsedRange.ClearContents
For i = 1 To nf
    With Sheets(i).Select
        If Sheets(i).Name <> "RISULTATO" Then
        Range("A1").AutoFilter Field:=4, Criteria1:="NO"
        Sheets(i).UsedRange.Copy ThisWorkbook.Worksheets("RISULTATO").Cells(5000, 1).End(xlUp).Offset(1, 0)
        End If
Sheets(i).AutoFilterMode = False
  
    End With
Next i
End Sub

di nichicanta data: 26/05/2014 16:05:30
Scusami per gli errori di battitura, ho una tastiera che fa i capricci, volevo dirti questo:
prova questa e dimmi se va bene, l'ho adattata al tuo quesito, cambia la colonna su cui applicare il filtro di tutti i fogli da copiare nel foglio "RISULTATO", cambia il valore in questa riga:Field:=4 ( il numero indica la colonna su cui applicare il filtro).
Ti saluto.

di ELIAS (utente non iscritto) data: 26/05/2014 16:14:35
La ringrazio tantissimo nichicanta!! apprezzo sempre la sua disponibilità ad aiutarmi!! Comunque, Le colonne possono variare, Una volta dovrei aggiungere ed una volta forse elimino. Funzionerà lo stesso? magari potrei fare un filtro nella riga che cerca la parola disponibilità e prende tutti i "no" nella colonna di disponibilità. una cosa tipo quest'istruzione

Ncol = ActiveSheet.Rows(9).Find(what:="DISPONIBILITA'").Column

Worksheets("RISULTATO").Range("a7").CurrentRegion.Clear
    
    With ActiveSheet.Range("$A$9")
    .AutoFilter field:=Ncol, Criteria1:="NO"
    .CurrentRegion.Copy Sheets("RISULTATO").Range("a7")
    .AutoFilter field:=Ncol

di ELIAS (utente non iscritto) data: 26/05/2014 16:35:21
Ho provato a farla funzionare ma avendo tabelle con colonne diverse ( perche le tabelle nei 4 folgi di lavoro sono diverse, cioè variano le colonne ) non funziona

di nichicanta data: 26/05/2014 16:35:38
potresti provare ad inserire diversi criteri di filtro che si applicano su diverse colonne come ti ho riportato sotto ( penso che tu non possa inserire tante altre colonne su cui applicare i filtri e/o ricercare altro dato)

Sub m()
Dim nf As Long, i As Long 'A3, E100!
  nf = ThisWorkbook.Sheets.Count
  Application.ScreenUpdating = False
  Sheets("RISULTATO").UsedRange.ClearContents
For i = 1 To nf
    With Sheets(i).Select
        If Sheets(i).Name <> "RISULTATO" Then
        Range("A9:E9").AutoFilter Field:=5, Criteria1:="NO", Operator:=xlAnd
        Range("A9:E9").AutoFilter Field:=2, Criteria1:="DISPONIBILITA'", Operator:=xlAnd
        Range("A9:E9").AutoFilter Field:=1, Criteria1:=" QUI CI METTI UN ALTRO CRITERIO DI FILTRO E COSI VIA ", Operator:=xlAnd      
        
               Sheets(i).UsedRange.Copy ThisWorkbook.Worksheets("RISULTATO").Cells(5000, 1).End(xlUp).Offset(1, 0)
        End If
Sheets(i).AutoFilterMode = False
Sheets("RISULTATO").Select
    End With
Next i
End Sub

di ELIAS (utente non iscritto) data: 26/05/2014 16:38:36
La provo subito Comunque ci sono delle tabelle che avvolte dovrei aggiungere 100 colonne e ci sono tabelle che rimangono le stesse perciò ho pensato di farla sulla riga vista che non varia mai questa
di nichicanta data: 26/05/2014 16:48:46
tieni presente che l'ultimo codice necessita di due o più (dipende da te cosa vuoi fare)criteri di ricerca, nel caso dovessi filtrare solo per SI e NO non funzionerebbe, in questo caso dovresti usare il primo codice ed eliminare le altre condizioni create con l'operatore:xlAnd
di ELIAS (utente non iscritto) data: 26/05/2014 16:51:50
Non funzione essendo che non so quasi mai quante colonne potrei aggiungere, non posso specificare la colonna perché nel mio caso è sempre variabile. perciò io vorrei che andasse nella riga numero 9 in tutte le tabelle ed andare alla parola disponibilità e trovare tutti i "NO" e copiare le righe con "NO" nel foglio dei risultati.

di Mister_x (utente non iscritto) data: 26/05/2014 18:31:08
riciao

quindi stando al tuo ultimo esposto,e non sapendo a priori quante colonne ha un articolo, ti propongo questa sub(), la quale ha due posizioni fisse, quelle di ricerca del NO in Colonna E su tutti i fogli e la partenza in riga 10 ,
il riporto viene fatta sia che le colonne vanno da un minimo di 5 a un max di x dato che si calcola da sola quante sono per riga occupate

ciao

'' da inserire in un Modulo
Option Explicit

Sub Copia_NO_Risultato()
Dim Foglio As Variant
Dim i As Long, o As Long, e As Long, Nriga As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Nriga = 10
Sheets("RISULTATO").Select
Range("A9:ZZ10000").ClearContents
For i = 1 To Sheets.Count
  Foglio = UCase(Sheets(i).Name)
  If Foglio <> "RISULTATO" Then
  Cells(Nriga - 1, "E") = UCase(Sheets(i).Name)
    For o = 10 To Sheets(i).Cells(Rows.Count, "E").End(xlUp).Row
      If Sheets(i).Cells(o, "E") = "NO" Then
       For e = 1 To Sheets(i).Cells(o, Columns.Count).End(xlToLeft).Column
        Cells(Nriga, e) = Sheets(i).Cells(o, e)
       Next e
        Nriga = Nriga + 1
      End If
    Next o
    Nriga = Nriga + 6
  End If
 Next i
 Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

di ELIAS (utente non iscritto) data: 27/05/2014 09:33:26
Ho provato ad aggiungere ad esempio due colonne prima della colonna disponibilità cioè la colonna "E" e mi da risultati vuoti la colonna E da cui ho i risultati "SI" e "NO" varia molto spesso, avvolte sta ad "x" avvolte "yx", "dp", "y" ecc.. perciò io avrei voluto che dalla riga 9 la macro andasse a rilevare la parola Disponibilità cioè la colonna dove stanno "SI" e "NO" e dopo facesse un filtro prendendo solo i risultati "NO". ps. La riga 9 nella tabella quella non varia mai, ho tutte le tabelle che partono dalla riga 9. Sono le colonne che variano, sopratutto la E che sta alla fine ed io dovendo sempre aggiungere colonne prima della colonna E, la E varia sempre.

di Mister_x (utente non iscritto) data: 27/05/2014 09:45:31
ciao

certo che come spiegazione bisogna sempre strapparle dalla bocca, comunque a questo punto la sub() cerca in qualsiasi punto del foglio la parola di intestazione "DISPONIBILITA'" e va a questo punto scrivere nel foglio tutti i valori trovati in NO,
da come vedrai adesso la sub ti riporta il nome del foglio, l'intestazione e i suoi relativi dati

ti posto il file con la Modifica fatta e il risultato che otterrai

ciao

'' da inserire in un Modulo
Option Explicit

Sub Copia_NO_Risultato()
Dim Foglio As Variant
Dim i As Long, o As Long, e As Long, Nriga As Long
Dim Intestazione As Range
Dim In_riga As Long, In_col As Long
Dim cella As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
Nriga = 1
Sheets("RISULTATO").Select
Range("A1:ZZ10000").ClearContents
For i = 1 To Sheets.Count
  Foglio = UCase(Sheets(i).Name)
  If Foglio <> "RISULTATO" Then
  Set Intestazione = Sheets(i).Range("A1:ZZ20")
  '''
   For Each cella In Intestazione
     If UCase(cella.Value) = "DISPONIBILITA'" Then
       In_riga = cella.Row
        In_col = cella.Column
      Exit For
     End If
   Next
  ''' Intestazione
  Cells(Nriga, 1) = UCase(Sheets(i).Name)
  Nriga = Nriga + 1
  For e = 1 To Sheets(i).Cells(In_riga, Columns.Count).End(xlToLeft).Column
        Cells(Nriga, e) = Sheets(i).Cells(In_riga, e)
   Next e
  Nriga = Nriga + 1
  ''
    For o = In_riga To Sheets(i).Cells(Rows.Count, In_col).End(xlUp).Row
      If Sheets(i).Cells(o, "E") = "NO" Then
       For e = 1 To Sheets(i).Cells(o, Columns.Count).End(xlToLeft).Column
        Cells(Nriga, e) = Sheets(i).Cells(o, e)
       Next e
        Nriga = Nriga + 1
      End If
    Next o
    Nriga = Nriga + 2
  End If
 Next i
 Set Intestazione = Nothing
 Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

di Mister_x (utente non iscritto) data: 27/05/2014 09:52:18
riciao

errrata corrige
ho dimenticato una variabile nella sub()
da cosi
If Sheets(i).Cells(o, "E") = "NO" Then

a cosi
If Sheets(i).Cells(o, In_col) = "NO" Then

altimenti non controlla la colonna interessata
risposto il file con la modifica fatta
riciao
di ELIAS (utente non iscritto) data: 27/05/2014 10:35:04
Grazie Mille Mister_X non si può copiare anche la tabella e non solo i valori nella tabella? magari si potesse fare sarebbe perfetta

di Mister_x (utente non iscritto) data: 27/05/2014 11:58:18
riciao

sub() con colore e bordi

ciao

allego sempre il file di prova Bordi

'' da inserire in un Modulo
Option Explicit

Sub Copia_NO_Risultato()
Dim Foglio As Variant
Dim i As Long, o As Long, e As Long, Nriga As Long
Dim Intestazione As Range
Dim In_riga As Long, In_col As Long
Dim cella As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
Nriga = 1
Sheets("RISULTATO").Select
Range("A1:ZZ10000").Clear  ''Contents
For i = 1 To Sheets.Count
  Foglio = UCase(Sheets(i).Name)
  If Foglio <> "RISULTATO" Then
  Set Intestazione = Sheets(i).Range("A1:ZZ20")
  '''
   For Each cella In Intestazione
     If UCase(cella.Value) = "DISPONIBILITA'" Then
       In_riga = cella.Row
        In_col = cella.Column
      Exit For
     End If
   Next
  ''' Intestazione
  Cells(Nriga, 1) = UCase(Sheets(i).Name)
  Cells(Nriga, 1).Select
    With Selection
      .Interior.ColorIndex = 6
      .Font.ColorIndex = 3
    End With
   Call Bordi
      ''
  Nriga = Nriga + 1
  For e = 1 To Sheets(i).Cells(In_riga, Columns.Count).End(xlToLeft).Column
        Cells(Nriga, e) = Sheets(i).Cells(In_riga, e)
        Cells(Nriga, e).Select
     With Selection
          .Interior.ColorIndex = 44
          .Font.ColorIndex = 9
     End With
   Call Bordi
   Next e
  Nriga = Nriga + 1
  ''
    For o = In_riga To Sheets(i).Cells(Rows.Count, In_col).End(xlUp).Row
      If Sheets(i).Cells(o, In_col) = "NO" Then
       For e = 1 To Sheets(i).Cells(o, Columns.Count).End(xlToLeft).Column
        Cells(Nriga, e) = Sheets(i).Cells(o, e)
        Cells(Nriga, e).Select
        With Selection
          .Interior.ColorIndex = 4
          .Font.ColorIndex = 1
        End With
   Call Bordi
       Next e
        Nriga = Nriga + 1
      End If
    Next o
    Nriga = Nriga + 2
  End If
 Next i
 Set Intestazione = Nothing
 [a1].Select
 Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Sub Bordi()
With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

di ELIAS (utente non iscritto) data: 27/05/2014 12:18:46
Gentilissimo!!!! funzione benissimo!! Grazie infinite ancora
di ELIAS (utente non iscritto) data: 27/05/2014 12:52:21
Cambiando i dati per adattarlo al mio documento ( Disponibilità con Risultati e NO con FALSO ) mi da un errore sulla riga qui sotto, come mai non si adatta e mi dice errore in giallo sulla riga qui sotto???
For e = 1 To Sheets(i).Cells(In_riga, Columns.Count).End(xlToLeft).Column

di Mister_x (utente non iscritto) data: 27/05/2014 14:11:11
cioa

quindi il file che hai postato non corrisponde esattamente alla colonna diciamo dei NO scritto ma possiamo trovare anche un FALSO dato che arriva da una formula o al posto di un SI un VARe quindi prova a modificare questo pezzo
altrimenti posta il tuo file veramente come stanno le cose
ciao
riposto sempre l'ultimo file con la modifica aggiornata

da cosi
If Sheets(i).Cells(o, In_col) = "NO" Then
       For e = 1 To Sheets(i).Cells(o, Columns.Count).End(xlToLeft).Column
a cosi
For o = In_riga To Sheets(i).Cells(Rows.Count, In_col).End(xlUp).Row
      If Sheets(i).Cells(o, In_col) = "NO" Or Sheets(i).Cells(o, In_col) = False Then

di Elias (utente non iscritto) data: 28/05/2014 20:12:24
Ho provato ad applicarlo ad un file simile che ha più colonne ed al posto di disponibilità ce risultato, ed al posto di no ce falso.. ma è uguale.. però non funziona Non dovrebbe funzionare? Ps. Magari potessi mettere il mio file ma per motivi di privacy non posso
di Mister_x (utente non iscritto) data: 28/05/2014 22:51:10
ciao

attualmente non so' leggere nella mente di un altro, cerco di capire cosa vuole se spiegato,
ma se per caso tu posti il tuo file lasciando la struttura esatta di come e', togliendo dati sensibili, tipo nomi via codfisc numeri tel. e lasci solo il dato vero dove dobbiamo valutare la cosa,FORSE SI RISOLVE, altrimenti ad indovinare e' molto difficile,
sappi che io nel gioco , lotto enalotto gratta e perdi, sono molto fortunato, VINCO SEMPRE,
NON GIOCO MAI

ciao
di ELIAS (utente non iscritto) data: 29/05/2014 09:57:05
Ho allegato il mio file Es1.
di Mister_x (utente non iscritto) data: 29/05/2014 13:01:09
ciao

se non cambi l'intrstazione della colonna certo che avrai sempre un errore
For Each cella In Intestazione
If UCase(cella.Value) = "DISPONIBILITA'" Then

nel tuo deve cercare l'intestazione RISULTATO dato che la colonna interessata e' nominata Risultato e non Disponibilita' come avevi detto precedentemente e mai corretto
For Each cella In Intestazione
If UCase(cella.Value) = "RISULTATO" Then

ti riallego il tuo file ES1 modificato dove in modulo1 ho inserito la sub() funzionante egregiamente

ciao

comunque
di ELIAS (utente non iscritto) data: 03/06/2014 09:44:44
Grazie!!

Vuoi Approfondire?