1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
| Sub Enreg_classeur()
On Error GoTo ErrSelect
Dim Fichier As String, Feuille As String, dlig As Long
Fichier = [B5] & ".xlsx": Feuille = [B6]
If Dir(Fichier) = "" Then
Workbooks.Add -4167: ActiveWorkbook.Author = ""
Else
Workbooks.Open Fichier: Worksheets(Feuille).Select
End If
dlig = [A1].CurrentRegion.Rows.Count
If dlig > 1 Then Range("A1:F" & dlig).ClearContents
With Workbooks("Données")
With .Worksheets("Liste")
.[A1].CurrentRegion.SpecialCells(xlCellTypeVisible).Copy [A1]
Columns("A:F").AutoFit
End With
With .Worksheets("Prestation")
ActiveSheet.Name = .[B6]
End With
End With
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Fichier
Application.DisplayAlerts = True
Exit Sub
ErrSelect:
Worksheets.Add , Worksheets(Worksheets.Count)
Resume Next
End Sub |
Partager