Copier une feuille vers un autre classeur puis refermer

yakin78

XLDnaute Junior
onjour à Tous

j'aimerai modifier ce bout de code ,mais au lieu de copier dans le classeur actuel le faire avec une ouverture d'un autre classeur (meme dossier/classeurCible.xls) et copier la feuille (date de B1) dessus

Code:
Private Sub NewPage_Click()
'   Creation page
    Application.ScreenUpdating = False
    
    Dim nomNewWS As String
    Dim trouveWS As Boolean
    Application.ScreenUpdating = False
    Sheets("page source").Select
    
    
' Nom de la nouvelle feuille (dans la page source cellule B1 est inscrit la date a creer)
    nomNewWS = Application.WorksheetFunction.Proper(Format(Range("B1").Value, "mmmm yyyy"))
    
' Vérifier que la feuille n'existe pas déjà
    trouveWS = VerifFeuille(nomNewWS)
    
'     Si la feuille existe déjà, ne rien faire
    If trouveWS = True Then
    MsgBox ("La page " & nomNewWS & " Existe déja!!"), vbExclamation, "Attention !"
    End If
    If trouveWS = True Then Exit Sub
       
' Ajouter une feuille dans le classeur
    ActiveSheet.Copy after:=Worksheets(ThisWorkbook.Worksheets.Count)
    
    With ActiveSheet
' Renommer la feuille au mois suivant
        .Name = nomNewWS
   
    End With
    
End Sub

 ' -------------------------------------------------------------------------------

Public Function VerifFeuille(wsFeuil As String)
   Application.ScreenUpdating = False
    Dim WS As Integer

    VerifFeuille = False

    ' Boucle sur toutes les feuilles du classeur
    For WS = 1 To ThisWorkbook.Worksheets.Count
        If Worksheets(WS).Name = wsFeuil Then
            VerifFeuille = True
            Exit For
        End If
    Next WS
    Application.ScreenUpdating = True
End Function

merci d'avance !!
 
G

Guest

Guest
Re : Copier une feuille vers un autre classeur puis refermer

Bonjour,
A tester
Code:
Private Sub NewPage_Click()
'   Creation page
    Dim shSource As Worksheet 'feuille source
    Dim wkDestination As Workbook ' classeur destination
    Dim nomNewWS As String 'nouveau nom de la feuille
    Dim trouveWS As Boolean 'la feuille existe-t-elle déjà?
    
    Application.ScreenUpdating = False
'référence à la feuille source
' Nom de la nouvelle feuille (dans la page source cellule B1 est inscrit la date a creer)
    nomNewWS = Application.WorksheetFunction.Proper(Format(shSource.Range("B1").Value, "mmmm yyyy"))
    
' ouvrir le classeur
    On Error Resume Next
    Set wkDestination = Workbooks.Open(ThisWorkbook.Path & "\classeurCible.xls")
    If wkDestination Is Nothing Then
        MsgBox "Classeur introuvable"
        On Error GoTo 0
        Exit Sub
    End If
    
' Vérifier que la feuille n'existe pas déjà
    trouveWS = wkDestination.Sheets(nomNewWS).Name = nomNewWS
    
'     Si la feuille existe déjà, ne rien faire
    If trouveWS = True Then
        MsgBox ("La page " & nomNewWS & " Existe déja!! dans le classeur cible"), vbExclamation, "Attention !"
        On Error GoTo 0
        Exit Sub
    End If
' Ajouter une feuille dans le classeur cible
    shSource.Copy after:=wkDestination.Worksheets(wkDestination.Worksheets.Count)
    '
    wkDestination.Worksheets(shSource.Name).Name = nomNewWS
    wkDestination.Save
    wkDestination.Close
    '
' activer la feuille source
    shSource.Active
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub

A+
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Copier une feuille vers un autre classeur puis refermer

Bonjour Yakin, bonjour le forum,

Peut-être comme ça :
Code:
Private cc As Workbook 'déclare la variable cc (Classeur Cible)

Private Sub NewPage_Click()
'   Creation page
   
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim ncc As String 'déclare la variable ncc (Nom di Classeur Cible)
Dim nomNewWS As String
Dim trouveWS As Boolean

Application.ScreenUpdating = False
Set cs = ThisWorkbook 'définit le classeur source cs
ncc = cs.Path & "\classeurCible.xls" 'définit le nom ncc du classeur cible
Workbooks.Open (ch) 'ouvre le classeur cible
Set cc = ActiveWorkbook 'définit le classeur cible
  
' Nom de la nouvelle feuille (dans la page source cellule B1 est inscrit la date a creer)
nomNewWS = Application.WorksheetFunction.Proper(Format(cs.Sheets("page source").Range("B1").Value, "mmmm yyyy"))
   
' Vérifier que la feuille n'existe pas déjà
trouveWS = VerifFeuille(nomNewWS)
   
'     Si la feuille existe déjà, ne rien faire
If trouveWS = True Then
    MsgBox ("La page " & nomNewWS & " Existe déja!!"), vbExclamation, "Attention !"
End If
If trouveWS = True Then Exit Sub

' Ajouter une feuille dans le classeur
ActiveSheet.Copy after:=cc.Worksheets(cc.Worksheets.Count)
cc.Worksheets(cc.Worksheets.Count).Name = nomNewWS
cc.Close SaveChanges:=True
Application.ScreenUpdating = False
End Sub

 ' -------------------------------------------------------------------------------

Public Function VerifFeuille(wsFeuil As String)
Application.ScreenUpdating = False
Dim WS As Integer

VerifFeuille = False
' Boucle sur toutes les feuilles du classeur
For WS = 1 To cc.Worksheets.Count
    If Worksheets(WS).Name = wsFeuil Then
        VerifFeuille = True
        Exit For
    End If
Next WS
Application.ScreenUpdating = True
End Function

[Édition]Bonjour Hasco on s'est croisé...
 
Dernière édition:

yakin78

XLDnaute Junior
Re : Copier une feuille vers un autre classeur puis refermer

Bonjour et merci Hasco

j'ai un bug à cette ligne ci: shSource.Active
Affiche erreur: Membre de methodes ou de données introuvable

Je croit qu'il manque quelque chose entre ces 2 lignes

Code:
'référence à la feuille source
' Nom de la nouvelle feuille (dans la page source cellule B1 est inscrit la date a creer)

re-edit

j'ai rajouter cette ligne entre les 2
Set shSource = Sheets("page source")

mais j'ai toujours cette erreur
à cette ligne : shSource.Active
Affiche erreur: Membre de methodes ou de données introuvable
 
Dernière édition:

Discussions similaires

Réponses
5
Affichages
275

Statistiques des forums

Discussions
314 647
Messages
2 111 533
Membres
111 191
dernier inscrit
Assjmka