Copier cellules d'une feuille vers une autre feuille d'un classeur fermé

Bonjour,

Etant tout nouveau dans le monde du VBA et ayant besoin de réduire ma charge de travail au sein de mon entreprise, je permet de vous sollicité pour avoir de l'aide. mes recherches ont été vaines concernant mes besoins assez précis.

Est il possible en VBA:

1- de dupliquer les cellules d'une feuille active vers le classeur2, qu'il crée une feuille (message box pour la nommer) avec les cellules du classeur1 sélectionner.

2- sans lui indiquer le nom de la feuille active du classeur1 (c'est un planning et tout les jours il change de nom) pour pourvoir dupliquer avec un bouton la sélection de cellule d'une feuille sur le classeur1 vers le classeur 2 a l'infini.

pour info la feuille sur laquelle je veux copier les cellules sur un classeur2 est une feuille que je duplique par un bouton en la renommant par message box.

Merci pour votre aide précieuse.

J'ai ce code qui fonctionne bien pour dupliquer la page mais je n'arrive pas a juste sélectionner les cellules qui m'intéressent et a renommer les pages copier comme je le souhaite si quelqu'un peux m'aider ?

Sub dupliquerFeuilleDansClasseurFerme()

' dupliquer la feuille active dans un classeur fermé

Dim classeurActif As String, classeurCible As String

classeurActif = ActiveWorkbook.Name

classeurCible = "Classeur.xlsm"

' ouvrir le classeur

Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & classeurCible

' on revient au classeur d'origine

Windows(classeurActif).Activate

' dupliquer la feuille

ActiveSheet.Copy after:=Workbooks(classeurCible).Sheets(Workbooks(classeurCible).Sheets.Count)

' fermer et enregistrer le classeur

Workbooks(classeurCible).Close True

End Sub

Edit modo : mettre le code entre balise avec le bouton </>

le forum est désert ?

Bonjour,

comment y ajouter ma sélection de cellules ?

" ' dupliquer la feuille

ActiveSheet.Copy after:=Workbooks(classeurCible).Sheets(Workbooks(classeurCible).Sheets.Count)"

Bonjour Stéphanek

Non, le forum n'est pas désert

En général quand on obtient pas de réponse, c'est que la demande est mal formulée ou incompréhensible !

Et pour moi c'est le cas

Bonjour BrunoM45,

Ok, en faite je veux copier une plage de cellule d'un classeur sur un autre classeur en activant une macro

et qu'a chaque fois que j'active la macro cela crée une nouvelle page sur le deuxième classeur avec la plage de macro copiée du premier.

C'est plus clair ?

Bonjour,

Avez-vous essayer d'utiliser l'enregistreur de macros dans le menu développeur,
cela peut vous donner une idée du code, qu'il faut en général retravailler un peut

Voici une possibilité (si j'ai bien compris)

Sub CopierUnePlage()
  Dim WbkSource As Workbook, WbkDest As Workbook
  Dim PlageACopier As Range
  Dim NomFeuille As String

  Set WbkSource = ActiveWorkbook
  ' Définir la page à copier = cellule(s) sélectionnée(s)
  Set PlageACopier = Selection
  ' ouvrir le classeur
  Set WbkDest = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\Classeur.xlsm")
  ' dupliquer la feuille
  WbkDest.Sheets.Add After:=WbkDest.Sheets(WbkDest.Sheets.Count)
  NomFeuille = InputBox("Quel nom voulez vous donner à la feuille ?", "NOM FEUILLE")
  If NomFeuille <> "" Then
    WbkDest.ActiveSheet.Name = NomFeuille
  End If
  WbkDest.ActiveSheet.Range(PlageACopier.Address).Value = PlageACopier.Value
  ' fermer et enregistrer le classeur
  WbkDest.Close SaveChanges:=True
End Sub

A+

Merci Bruno,

oui j'avais essayé l'enregistreur de macro mais le résultat n'était pas concluant.

ton code fonctionne super bien !

juste une dernière chose peut ont copier la mise en forme de la feuille active (éventuellement les couleurs) et peut ont laisser le deuxième classeur ouvert a la fin du transfert ?

Re,

Pour la fermeture du 2ème classeur, je pense que mes indications sont assez explicite non sinon ça sert à quoi

Voici le code, avec la ligne de fermeture en commentaire

Sub CopierCollerPlageAvecValeurEtFormat()
  Dim WbkSource As Workbook, WbkDest As Workbook
  Dim PlageACopier As Range
  Dim NomFeuille As String
  ' Définir le classeur source
  Set WbkSource = ActiveWorkbook
  ' Définir la page à copier = cellule(s) sélectionnée(s)
  Set PlageACopier = Selection
  ' ouvrir le classeur
  Set WbkDest = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\Classeur.xlsm")
  ' dupliquer la feuille
  WbkDest.Sheets.Add After:=WbkDest.Sheets(WbkDest.Sheets.Count)
  ' Demander le nom de la feuille
  NomFeuille = InputBox("Quel nom voulez vous donner à la feuille ?", "NOM FEUILLE")
  If NomFeuille <> "" Then
    ' Renommer la feuille si non donné
    WbkDest.ActiveSheet.Name = NomFeuille
  End If
  ' Copier la plage source
  PlageACopier.Copy
  ' La coller avec valeru et format
  With WbkDest.ActiveSheet.Range(PlageACopier.Address)
      .PasteSpecial Paste:=xlPasteValues
      .PasteSpecial Paste:=xlPasteFormats
  End With
  ' Fermer et enregistrer le classeur
  ' WbkDest.Close SaveChanges:=True
  ' Important !
  ' Effacer les variables objet pour libérer la mémoire
  Set WbkDest = Nothing: Set PlageACopier = Nothing: Set WbkSource = Nothing
End Sub

A+

Effectivement mais j'avais mis open a la place de close pour tester = erreur (Bon je débute),

Merci pour ton aide précieuse … tout fonctionne.

Encore une petite chose

A+

Bonjour,

j'ai un soucis que je n'arrive pas a résoudre.

j'aimerais ajouter plusieurs sélections de cellule comme suit: (mais j'ai un message d'erreur) ?

Sub CopierCollerPlageAvecValeurEtFormat()
Dim WbkSource As Workbook, WbkDest As Workbook
Dim Rng1, Rng2, Rng3 As Range
Dim NomFeuille As String

' Définir le classeur source
Set WbkSource = ActiveWorkbook
' Définir la page à copier = cellule(s) sélectionnée(s)

Set Rng1 = Range("G1:J18")
Set Rng2 = Range("L3:Q18")
Set Rng3 = Range("S3:U18")
Union(Rng1, Rng2, Rng3).Select 'si la sélection est nécessaire
' ouvrir le classeur
Set WbkDest = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\classe.xlsm")
' dupliquer la feuille
WbkDest.Sheets.Add After:=WbkDest.Sheets(WbkDest.Sheets.Count)
' Copier la plage source
Union.Copy

' La coller avec valeur et format
With WbkDest.ActiveSheet.Range(Union(Rng1, Rng2, Rng3).Address).End(xlUp)
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
.Application.CutCopyMode = False
End With
' Important !
' Effacer les variables objet pour libérer la mémoire
Set WbkDest = Nothing: Set PlageACopier = Nothing: Set WbkSource = Nothing
End Sub

Bonjour Stéphanek

1) merci d'éditer votre post et mettre votre code entre balises avec le bouton
Vous editer votre post, coupez le code, cliquez sur le bouton et colle le code dans la fenêtre

Un "PasteSpécial" ne peut pas se faire sur des cellules discontinues

Il faut le faire zone par zone

A+

Bonjour Bruno,

D'accord mais un peu trop complexe pour moi.

As tu une solution a me proposer en modifiant le code que tu m'avais fait ? (qui fonctionne très bien):

Sub CopierCollerPlageAvecValeurEtFormat()
  Dim WbkSource As Workbook, WbkDest As Workbook
  Dim PlageACopier As Range
  Dim NomFeuille As String
  ' Définir le classeur source
  Set WbkSource = ActiveWorkbook
  ' Définir la page à copier = cellule(s) sélectionnée(s)
  Set PlageACopier = Selection
  ' ouvrir le classeur
  Set WbkDest = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\Classeur.xlsm")
  ' dupliquer la feuille
  WbkDest.Sheets.Add After:=WbkDest.Sheets(WbkDest.Sheets.Count)
  ' Demander le nom de la feuille
  NomFeuille = InputBox("Quel nom voulez vous donner à la feuille ?", "NOM FEUILLE")
  If NomFeuille <> "" Then
    ' Renommer la feuille si non donné
    WbkDest.ActiveSheet.Name = NomFeuille
  End If
  ' Copier la plage source
  PlageACopier.Copy
  ' La coller avec valeur et format
  With WbkDest.ActiveSheet.Range(PlageACopier.Address)
      .PasteSpecial Paste:=xlPasteValues
      .PasteSpecial Paste:=xlPasteFormats
  End With
  ' Fermer et enregistrer le classeur
  ' WbkDest.Close SaveChanges:=True
  ' Important !
  ' Effacer les variables objet pour libérer la mémoire
  Set WbkDest = Nothing: Set PlageACopier = Nothing: Set WbkSource = Nothing
End Sub

Merci ton aide.

Re,

Code à essayer

Attention, il faut remplacer "NomFeuille" par le vrai nom de la feuille

Sub CopierCollerPlageAvecValeurEtFormat()
  Dim WbkSource As Workbook, WbkDest As Workbook
  Dim PlageACopier As Range, TabRng
  Dim IndRng As Integer
  ' Définir le classeur source
  Set WbkSource = ThisWorkbook
  '
  ' Ouvrir le classeur de destination ICI
  Set WbkDest = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\Classeur.xlsm")
  ' Créer une nouvelle feuille
  WbkDest.Sheets.Add After:=WbkDest.Sheets(WbkDest.Sheets.Count)
  '
  ' Mettre les plages à copier dans un tableau
  TabRng = Split("G1:J18,L3:Q18,S3:U18", ",")
  ' Pour chaque plage à copier du tableau
  For IndRng = 0 To UBound(TabRng)
    'Définir la plage à copier
    Set PlageACopier = WbkSource.Sheets("NomFeuille").Range(TabRng(IndRng))
    ' Copier la plage source
    PlageACopier.Copy
    ' La coller avec valeur et format
    With WbkDest.ActiveSheet.Range(PlageACopier.Address)
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
    End With
  Next IndRng
  ' Fermer et enregistrer le classeur
  ' WbkDest.Close SaveChanges:=True
  ' Important !
  ' Effacer les variables objet pour libérer la mémoire
  Set WbkDest = Nothing: Set PlageACopier = Nothing: Set WbkSource = Nothing
End Sub

A+

Bruno,

Pourrais-tu être un peu plus explicite, je suis néophyte.

Merci.

Re,

Tu ne pouvais pas comprendre, j'avais viré mon code après un ultime test qui ne fonctionnait pas

Regarde mon post précédent STP

A+

Bonjour Bruno,

ton code fonctionne très bien.

est il possible de ne pas nommer la feuille de calcul a copier car le nom va changer souvent ? et que la plage a copier se colle sur la colonne A ?

Merci.

Bonjour Stéphanek

Dans ce cas à tester

Sub CopierCollerPlageAvecValeurEtFormat()
  Dim WbkSource As Workbook, WbkDest As Workbook
  Dim PlageACopier As Range, TabRng
  Dim IndRng As Integer
  ' Définir le classeur source
  Set WbkSource = ThisWorkbook
  '
  ' Ouvrir le classeur de destination ICI
  Set WbkDest = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\Classeur.xlsm")
  ' Créer une nouvelle feuille
  WbkDest.Sheets.Add After:=WbkDest.Sheets(WbkDest.Sheets.Count)
  '
  ' Mettre les plages à copier dans un tableau
  TabRng = Split("G1:J18,L3:Q18,S3:U18", ",")
  ' Pour chaque plage à copier du tableau
  For IndRng = 0 To UBound(TabRng)
    'Définir la plage à copier
    Set PlageACopier = WbkSource.ActiveSheet.Range(TabRng(IndRng))
    ' Copier la plage source
    PlageACopier.Copy
    ' La coller avec valeur et format
    With WbkDest.ActiveSheet.Range("A" & Rows.Count).End(XlUp).Offset(1,0)
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
    End With
  Next IndRng
  ' Fermer et enregistrer le classeur
  ' WbkDest.Close SaveChanges:=True
  ' Effacer les variables objet pour libérer la mémoire
  Set WbkDest = Nothing: Set PlageACopier = Nothing: Set WbkSource = Nothing
End Sub

A+

J'ai une erreur