Foglio Excel Stampa solo righe che contengono determinati Valori

Question

Buon Giorno a tutti

Espongo il mio problema

Ho  un foglio di excel  di c.a  400 righe ( coppie di 200 righe legate tra loro ) e c.a 16 colonne , contenenti numeri, testo e formule

Ogni coppia di righe presenta una cella con "ESEGUITO" oppure "DA ESEGUIRE"  a seconda della relativa condizione

Utilizzo questo foglio come Riepilogo/Riassunto  di vari eventi in altri fogli della stessa cartella . (c.a 200 fogli )

E' possibile da excel  impostare stampa  solo righe  "DA ESEGUIRE"    ?????

Qualcuno conosce una soluzione

GRAZIE                                             Claudio

Answer 1

Ciao Claudio,

Ho inviato per email il file di esempio al tuo indirizzo Microsoft

One drive mi crea problemi perche' quando cerco di condividere il file mi chiede l'accesso al mio account microsoft (..penso che sia lo stesso che utilizzo per questo forum ....)

Ma  quando digito la password mi dice che non corrisponde ............?? ho anche seguito le istruzioni per ricevere un codice temporaneo ...ma la procedura si inchioda quando chiede di completare l'account

MI*****@yahoo.com che io completo con il mio account *** L'indirizzo di posta elettronica viene rimosso per motivi di privacy *** ....lui dice che deve iniziare con MI ..... le ho provate tutte ma non mi fa' entrare .........................

Ho ricevuto il tuo file e, per condividerlo con la Community, ho caricato il file Riepilogo Pratiche Prove Esempio.xlsm su Microsoft OneDrive a:  **http://1drv.ms/1Nl7Fi4**

===

Regards,

Norman

Answer 2

Buonasera

Mi  scuso ma ho mischiato le risposte ....il codice era di Norman Jones

Comunque  Confermo  B)

GRAZIE   GRAZIE   Claudio P

Answer 3

Buona sera

Intanto  grazie per la risposta

Poi  effettivamente il mio caso  e'  B) 

la prima riga contiene i titoli e la seconda le  risposte ,per cui e' importante stampare in alcuni casi tutto , ma normalmente solo tutte le coppie di righe dove c'e' la cella DA  ESEGUIRE  (che  e' SEMPRE  sotto quelle dei titoli ! )

Adesso  provo il tuo codice e poi comunico effetti  !!!!                  GRAZIE   GRAZIE  

Claudio P

Answer 4

Ciao Claudio P2002,

suppongo non ti basti stampare, come invece dici, *«solo righe  "DA ESEGUIRE"»*ma solo le coppie di righe "DA ESEGUIRE".

È giusta la mia ipotesi?

Verifichiamo... Quale di questi due esempi somiglia di più al tuo caso? Se nessuno dei due dovrai fornire maggiori chiarimenti.

Answer 5

Ciao Claudio,

Prova qualcosa del genere:

• Alt-F11 per aprire l'editor di VBA
• Alt-IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

 '=========>>

Option Explicit

'--------->>

Public Sub StampaDati()

    Dim WB As Workbook

    Dim SH As Worksheet, newSH As Worksheet

    Dim Rng As Range, Rng2 As Range, rngPrint As Range

    Dim rCell As Range, rngHeaders As Range

    Dim i As Long, iLastRow As Long

    Dim CalcMode As Long

    Const sFoglio As String = "Foglio1"                                 '<<==== Modifica

    Const sColonnaEseguito As String = "P"                           '<<==== Modifica

    Const sParola As String = "Da Eseguire"                         '<<==== Modifica

    Const NumeroDiColonne As Long = 16                        '<<==== Modifica

    Const sNewSheetName As String = "TempPrint"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)                          

    With SH

        iLastRow = LastRow(SH, .Columns("A:A"))

        Set Rng = .Range("A1:A" & iLastRow)

    End With

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

    End With

    For i = 2 To iLastRow Step 2

        Set rCell = Rng.Cells(i, sColonnaEseguito)

        With rCell

            If UCase(.Value) = UCase(sParola) Then

                If Rng2 Is Nothing Then

                    Set Rng2 = rCell.Resize(2)

                Else

                    Set Rng2 = Union(rCell.Resize(2), Rng2)

                End If

            End If

        End With

    Next i

    If Not Rng2 Is Nothing Then

        Set rngPrint = Intersect(Rng2.EntireRow, SH.UsedRange)

        Set rngHeaders = Rng.Rows(1).Resize(1, NumeroDiColonne)

        With WB

            On Error Resume Next

            Set newSH = .Sheets(sNewSheetName)

            On Error GoTo 0

            If Not newSH Is Nothing Then

                newSH.UsedRange.ClearContents

            Else

                Set newSH = .Worksheets.Add(Before:=.Sheets(1))

                newSH.Name = sNewSheetName

            End If

        End With

        With newSH

            rngHeaders.Copy Destination:=.Range("A1")

            rngPrint.Copy newSH.Range("A2")

            .UsedRange.EntireColumn.AutoFit

            .PrintPreview 'Out

        End With

    End If

XIT:

    With Application

        .Calculation = CalcMode

        .ScreenUpdating = True

    End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                 Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

'<<=========

• Alt-Q per chiudere l'editor di VBA e tornare a Excel.
• Alt-F8 per aprire  la finestra di gestione delle macro
• Seleziona StampaDati | Esegui

===

Regards,

Norman