While fic <> ""
If fic <> ThisWorkbook.Name Then
chemin = rep & fic
Workbooks.Open chemin, 0
Set Source = ActiveWorkbook.Sheets(1).Range("C9:C156")
Wf.Sheets.Add
Source.Copy
With Wf.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
i = i + 1
If i = 20 Then ThisWorkbook.Save: i = 0
nbf = nbf + 1
ActiveWorkbook.Close
End If
fic = Dir
Wend
Dim i As Integer
Sub CommandButton_Importation1()
Dim chemin As String
Dim rep As String
Dim fic As String
Dim Wf As Workbook
Dim source As Range
Dim ndf As Integer
rep = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
colonne = 1
On Error GoTo fin
Set Wf = ThisWorkbook
nbf = 0
fic = Dir(rep & "*.xls*")
While fic <> ""
If fic <> ThisWorkbook.Name Then
chemin = rep & fic
Workbooks.Open chemin, 0
Set source = ActiveWorkbook.Sheets(1).Range("C9:C156")
'Wf.Sheets.Add
source.Copy
With Wf.Sheets("Feuil1")
.Cells(1, colonne) = ActiveWorkbook.Name
.Cells(2, colonne).PasteSpecial Paste:=8
.Cells(2, colonne).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
colonne = colonne + 2
nbf = nbf + 1
ActiveWorkbook.Close
End If
fic = Dir
Wend
fin:
MsgBox "Procédure terminée, " & nbf & " feuilles ont été importées avec succès ", , "Importation"
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub