Copier une feuille excel

Contenu du snippet

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
  

Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.