Sub Exporter()
Dim exclu, w As Worksheet, n%, liste$(), wb As Workbook, Roc As Range, Cor As Range, derlig&, chemin$, nom1$, nom2
exclu = Array("Pomme", "Raisin", "Clémentine", "Melon", "Pastèque")
'---choix des feuilles--
For Each w In Worksheets
If IsError(Application.Match(w.Name, exclu, 0)) Then
If MsgBox("Exporter '" & w.Name & "' ?", 4) = 6 Then
n = n + 1
ReDim Preserve liste(1 To n)
liste(n) = w.Name
End If
End If
Next
If n = 0 Then MsgBox "Aucune feuille n'a été choisie...": Exit Sub
'---copie dans un document auxiliaire---
Application.ScreenUpdating = False
Set wb = Workbooks.Add(xlWBATWorksheet)
For Each w In ThisWorkbook.Worksheets
If IsNumeric(Application.Match(w.Name, liste, 0)) Then
Set Roc = w.Cells.Find("Roc", , xlValues, xlWhole)
Set Cor = w.Cells.Find("Cor")
If Not Roc Is Nothing And Not Cor Is Nothing Then
If Roc.Row = Cor.Row Then
derlig = w.Cells.SpecialCells(xlCellTypeLastCell).Row
Do While Roc.Row < derlig
Set Roc = Roc(2): Set Cor = Cor(2)
If Roc = 0 And Cor = 0 Then Roc.EntireRow.Hidden = True
Loop
End If
End If
w.Copy After:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).UsedRange = w.UsedRange.Value 'supprime les formules
wb.Sheets(wb.Sheets.Count).Name = w.Name
w.Rows.Hidden = False 'RAZ
End If
Next
'---création des fichiers Excel et PDF---
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.DisplayAlerts = False
wb.Sheets(1).Delete
nom1 = "Excel " & Format(Now, "yyyy-mm-dd hhmmss")
wb.SaveAs chemin & "Excel " & nom1
Set w = wb.Sheets(1)
For n = 2 To wb.Sheets.Count
With w.Rows(w.UsedRange.Row + w.UsedRange.Rows.Count)
wb.Sheets(n).UsedRange.EntireRow.Copy .Cells
w.HPageBreaks.Add Before:=.Cells(1) 'saut de page
End With
Next
w.PageSetup.PrintArea = w.UsedRange.Address 'zone d'impression
nom2 = "PDF " & Mid(nom1, 7)
w.ExportAsFixedFormat xlTypePDF, chemin & nom2, Quality:=xlQualityStandard
wb.Close False 'fermeture du fichier Excel
Application.ScreenUpdating = True
MsgBox "Fichiers '" & nom1 & "' et '" & nom2 & "' créés..."
End Sub