Public Sub CopierFeuilleExcel(ByVal sMonBookDeCopie As String, ByVal sMonBookDeDestination As String, ByVal sNomFeuilleACopier As String, ByVal sNomFeuilleCopier As String)
If Dir(sMonBookDeCopie) <> "" And Dir(sMonBookDeDestination) <> "" Then
Dim xlApp As Excel.Application
Dim xlBookDeCopie As Workbook
Dim xlBookDeDestination As Workbook
Dim i As Integer
Dim j As Integer
If sMonBookDeCopie <> sMonBookDeDestination Then
Set xlApp = CreateObject("Excel.Application")
Set xlBookDeCopie = xlApp.Workbooks.Open(sMonBookDeCopie)
Set xlBookDeDestination = xlApp.Workbooks.Open(sMonBookDeDestination)
For i = 1 To xlBookDeCopie.Sheets.Count
If xlBookDeCopie.Sheets(i).Name = sNomFeuilleACopier Then
xlBookDeCopie.Activate
xlBookDeCopie.Sheets(sNomFeuilleACopier).Select
xlBookDeCopie.Sheets(sNomFeuilleACopier).Copy After:=xlBookDeDestination. _
Sheets(xlBookDeDestination.Sheets.Count)
For j = 1 To xlBookDeDestination.Sheets.Count
If xlBookDeDestination.Sheets(j).Name = sNomFeuilleCopier Then
MsgBox "La feuille copiée n'a pas pu être renommée, ce nom existe déjà!", vbCritical
Exit For
ElseIf j = xlBookDeDestination.Sheets.Count Then
xlBookDeDestination.Sheets(j).Name = sNomFeuilleCopier
End If
Next j
Exit For
ElseIf i = xlBookDeCopie.Sheets.Count Then
MsgBox "La feuille à copier n'existe pas!", vbCritical
End If
Next i
xlBookDeCopie.Close True
xlBookDeDestination.Close True
xlApp.Quit
Set xlBookDeCopie = Nothing
Set xlBookDeDestination = Nothing
Set xlApp = Nothing
ElseIf sMonBookDeCopie = sMonBookDeDestination Then
Set xlApp = CreateObject("Excel.Application")
Set xlBookDeCopie = xlApp.Workbooks.Open(sMonBookDeCopie)
For i = 1 To xlBookDeCopie.Sheets.Count
If xlBookDeCopie.Sheets(i).Name = sNomFeuilleACopier Then
xlBookDeCopie.Activate
xlBookDeCopie.Sheets(sNomFeuilleACopier).Select
xlBookDeCopie.Sheets(sNomFeuilleACopier).Copy After:=xlBookDeCopie. _
Sheets(xlBookDeCopie.Sheets.Count)
For j = 1 To xlBookDeCopie.Sheets.Count
If xlBookDeCopie.Sheets(j).Name = sNomFeuilleCopier Then
MsgBox "La feuille copiée n'a pas pu être renommée, ce nom existe déjà!", vbCritical
Exit For
ElseIf j = xlBookDeCopie.Sheets.Count Then
xlBookDeCopie.Sheets(j).Name = sNomFeuilleCopier
End If
Next j
Exit For
ElseIf i = xlBookDeCopie.Sheets.Count Then
MsgBox "La feuille à copier n'existe pas!", vbCritical
End If
Next i
xlBookDeCopie.Close True
xlApp.Quit
Set xlBookDeCopie = Nothing
Set xlApp = Nothing
End If
Else
MsgBox "Le fichier n'existe pas, vérifier le chemin !", vbCritical
End If
End Sub
'Exemple d'utilisation
Private Sub CommandButton1_Click()
Call CopierFeuilleExcel("C:\Classeur3.xls", "C:\Classeur1.xls", "Feuil2", "CopieDeFeuil2")
Call CopierFeuilleExcel("C:\Classeur3.xls", "C:\Classeur3.xls", "Feuil2", "CopieDeFeuil2")
End Sub