Copie d'un onglet en valeur dans un fichier selectionné

**phoenix974** · 07/08/2016, 11h27

Bonjour a tous

J'aimerai copier un onglet ("FORMULE") de mon fichier actuel dans un fichier que 'utilisateur va sélectionner. Les données devront être collées en valeur.

J'ai commencé ce code mais j'ai une erreur l'indice n'appartient pas à la selection

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Exporter()
    Dim Fichier As Variant
    Dim Wb As Workbook
    Dim sh As Worksheet
 
'    Application.ScreenUpdating = False
 '   Application.DisplayAlerts = False
 
 
Set Source = ThisWorkbook.Sheets("FORMULE") 'Feuille a copier
 
    'Ouvre exploreur et permet aux utilisateur de selectionner le fichier de destination
    Fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsm), *.xlsx", MultiSelect:=False)
    'Si aucun fichier n'est selectionné, on arrete le code
    If Fichier = "" Then Exit Sub
 
        'On definit Wb qui ouvre le fichier selectionne
        Set Wb = Workbooks.Open(Fichier)
        'Feuille a copier
        Source.Copy After:=Workbooks(Fichier).Sheets(xlLast).PasteSpecial Paste:=xlPasteValues
 
        'On ferme le fichier source ouvert
        'Wb.Close False
 
  '  Application.ScreenUpdating = True
  '  Application.DisplayAlerts = True
 
End Sub

**Marc-L** · 07/08/2016, 11h50

Bonjour !

Vérifier la ligne déclenchant l'erreur (mauvaise valeur dans une variable) …

_________________________________________________________________________________________________________

Je suis Paris, Nice, Bruxelles, Charlie, …

**phoenix974** · 07/08/2016, 12h18

bonjour Marc

J'ai une erreur sur le ligne 7

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Source = ThisWorkbook.Sheets("FORMULE") 'Feuille a copier

Cela me dit Erreur de compilation objet requis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Exporter()
    Dim Fichier As Variant
    Dim Wb As Workbook
    Dim sh As Worksheet
 
'    Application.ScreenUpdating = False
 '   Application.DisplayAlerts = False
 
 
Set Source = ThisWorkbook.Sheets("FORMULE") 'Feuille a copier
 
    'Ouvre exploreur et permet aux utilisateur de selectionner le fichier de destination
    Fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsm), *.xlsx", MultiSelect:=False)
    'Si aucun fichier n'est selectionné, on arrete le code
    If Fichier = "" Then Exit Sub
 
        'On definit Wb qui ouvre le fichier selectionne
        Set Wb = Workbooks.Open(Fichier)
        'Feuille a copier
        Source.Copy After:=Workbooks(Fichier).Sheets(xlLast).PasteSpecial Paste:=xlPasteValues
 
        'On ferme le fichier source ouvert
        'Wb.Close False
 
  '  Application.ScreenUpdating = True
  '  Application.DisplayAlerts = True
 
End Sub

**patricktoulon** · 07/08/2016, 12h31

heu....
peut être parce que ton getopenfilename est a multiselect

et que fichier par la force des chose est une colecttion de fichier même si tu en choisi qu'un

donc copier la source dans collection ne peut pas marcher

donc boucler sur tout les fichiers sélectionnés puis ouvrir puis coller

edit
autant pour moi il est a false

je pense que la il faut jouer aussi avec les windowactivate

copier la course
activer le classeur destination
coller

**patricktoulon** · 07/08/2016, 13h02

re
en plus tu dis que tu veux les valeurs :cela sous entends qu'il y a des formules
donc si tu copie le sheets globalement tu aura les formules

essaie plutôt cela j'ai mis suffisamment de commentaires pour que cela soit compréhensible

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Exporter()
    Dim Fichier As Variant
    Dim Wb As Workbook
    Dim source As Range
    Set source = ThisWorkbook.Sheets("FORMULE").UsedRange    'plage a copier
    source.Copy
    'Ouvre exploreur et permet aux utilisateur de selectionner le fichier de destination
    Fichier = Application.GetOpenFilename("Fichiers Excel (*.xl*), *.xl*", MultiSelect:=False)
    'Si aucun fichier n'est selectionné, on arrete le code
    If Fichier = "" Then Exit Sub
    'On definit Wb qui ouvre le fichier selectionne
    Set Wb = Workbooks.Open(Fichier)
    Sheets.Add After:=Sheets(Sheets.Count)    'on ajoute un sheets dans le classeur que l'on vient d'ouvrir
    With Sheets(Sheets.Count)
        .Name = "FORMULE"    ' on le nomme pareil
        .Select
        .Range(source.Cells(1).Address).Select    ' on copie au meme endroit que dans la source en prenant l'adresse de la cel1 de la source
        ActiveSheet.Paste    ' on colle avec paste simple comme ca on a que les valeurs
        Application.CutCopyMode = False
        Wb.Save    'on sauve le classeur de destination
        Wb.Close    ' on le ferme
    End With
 
End Sub

**Philippe Tulliez** · 07/08/2016, 15h36

Bonjour,

J'ai commencé ce code mais j'ai une erreur l'indice n'appartient pas à la selection

La méthode Copya un argument facultatif qui est la cible mais avec cet argument, on ne peut pas faire de collage partiel.
Il faut donc passer par le collage spécial.
Manuellement c'est la méthode à utiliser mais en VBA je préfère passer par "plage.Value = Plage.Value" que je trouve moins lourde et tout aussi efficace.
Exemple de la copie d'une plage de cellules dans le même classeur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub CopyPasteWithoutFormula_Ex1()
  Dim rngSource As Range, rngTarget As Range
  With ThisWorkbook
   Set rngSource = .Worksheets("Feuil1").Range("A1").CurrentRegion
   Set rngTarget = .Worksheets("Feuil2").Range("A1")
  End With
  rngSource.Copy rngTarget
  With rngTarget: .Value = .Value: End With
End Sub

Autre exemple de la copie de l'ensemble des cellules de toute une feuille vers un nouveau classeur et remplacement ensuite des formules par leur valeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub CopyPasteWithoutFormula_Ex2()
  Dim shtSource As Worksheet
  Set shtSource = ThisWorkbook.Worksheets("Feuil1")
  shtSource.Copy
  With Workbooks(Workbooks.Count).Worksheets(1).UsedRange
  .Value = .Value
  End With
End Sub

**phoenix974** · 07/08/2016, 15h46

En faite je voulais copier tout l'onglet directement, pour pas avoir à créer un nouvel onglet dans le fichier sélectionné avant de coller les données de l'onglet source.

Quel serait le meilleur moyen du coup?

**phoenix974** · 07/08/2016, 15h51

Envoyé par patricktoulon

re
en plus tu dis que tu veux les valeurs :cela sous entends qu'il y a des formules
donc si tu copie le sheets globalement tu aura les formules

essaie plutôt cela j'ai mis suffisamment de commentaires pour que cela soit compréhensible

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Exporter()
    Dim Fichier As Variant
    Dim Wb As Workbook
    Dim source As Range
    Set source = ThisWorkbook.Sheets("FORMULE").UsedRange    'plage a copier
    source.Copy
    'Ouvre exploreur et permet aux utilisateur de selectionner le fichier de destination
    Fichier = Application.GetOpenFilename("Fichiers Excel (*.xl*), *.xl*", MultiSelect:=False)
    'Si aucun fichier n'est selectionné, on arrete le code
    If Fichier = "" Then Exit Sub
    'On definit Wb qui ouvre le fichier selectionne
    Set Wb = Workbooks.Open(Fichier)
    Sheets.Add After:=Sheets(Sheets.Count)    'on ajoute un sheets dans le classeur que l'on vient d'ouvrir
    With Sheets(Sheets.Count)
        .Name = "FORMULE"    ' on le nomme pareil
        .Select
        .Range(source.Cells(1).Address).Select    ' on copie au meme endroit que dans la source en prenant l'adresse de la cel1 de la source
        ActiveSheet.Paste    ' on colle avec paste simple comme ca on a que les valeurs
        Application.CutCopyMode = False
        Wb.Save    'on sauve le classeur de destination
        Wb.Close    ' on le ferme
    End With
 
End Sub

Bonjour Patrick,

J'ai essayé ton code mais avec Paste simple, cela me m'affiche des données avec des #valeurs.

Du coup, j'ai essayé ceci au niveau de la ligne 18:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
        ActiveSheet.PasteSpecial Paste:=xlPasteValues
        ActiveSheet.PasteSpecial Paste:=xlPasteFormats

Mais j'ai une erreur d'exectution 1004: erreur définie par l'application ou par l'objet

**phoenix974** · 07/08/2016, 16h29

Envoyé par Philippe Tulliez

Bonjour,

La méthode Copya un argument facultatif qui est la cible mais avec cet argument, on ne peut pas faire de collage partiel.
Il faut donc passer par le collage spécial.
Manuellement c'est la méthode à utiliser mais en VBA je préfère passer par "plage.Value = Plage.Value" que je trouve moins lourde et tout aussi efficace.
Exemple de la copie d'une plage de cellules dans le même classeur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub CopyPasteWithoutFormula_Ex1()
  Dim rngSource As Range, rngTarget As Range
  With ThisWorkbook
   Set rngSource = .Worksheets("Feuil1").Range("A1").CurrentRegion
   Set rngTarget = .Worksheets("Feuil2").Range("A1")
  End With
  rngSource.Copy rngTarget
  With rngTarget: .Value = .Value: End With
End Sub

Autre exemple de la copie de l'ensemble des cellules de toute une feuille vers un nouveau classeur et remplacement ensuite des formules par leur valeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub CopyPasteWithoutFormula_Ex2()
  Dim shtSource As Worksheet
  Set shtSource = ThisWorkbook.Worksheets("Feuil1")
  shtSource.Copy
  With Workbooks(Workbooks.Count).Worksheets(1).UsedRange
  .Value = .Value
  End With
End Sub

Bonjour Philippe,

je voudrais utiliser ton 2eme code mais je ne vois pas comment l'adapter au mien (Ouverture d'un fichier, ajout d'un onglet puis collage des données sur ce nouvel onglet)

**Philippe Tulliez** · 07/08/2016, 17h12

Bonjour,

je voudrais utiliser ton 2eme code mais je ne vois pas comment l'adapter au mien (Ouverture d'un fichier, ajout d'un onglet puis collage des données sur ce nouvel onglet)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub CopyPasteWithoutFormula_Ex3()
  Dim shtSource As Worksheet, wkbTarget As Workbook
  Dim File As String
  ' Sélection du classeur cible
  File = Application.GetOpenFilename("Fichiers Excel (Excel, *.xlsx", MultiSelect:=False)
  Select Case LCase(File)
    Case "false", "faux": Exit Sub
  End Select
  '
  Set shtSource = ThisWorkbook.Worksheets("Feuil1")
  Set wkbTarget = Workbooks.Open(File)
  '
  With wkbTarget
    shtSource.Copy Before:=.Sheets(1)
    With .Worksheets(1).UsedRange: .Value = .Value: End With
  End With
  ' ligne pour sauver le classeur cible
  Set shtSource = Nothing: Set wkbTarget = Nothing
End Sub

[EDIT]
Afin d'avoir une procédure plus "propre"
Il y a lieu de remplacer à la ligne 3, String par Variant. Soit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  Dim File As Variant

et remplacer les lignes 6, 7 et 8 par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
  On Error Resume Next
  If File = False Then Exit Sub
  On Error GoTo 0

**phoenix974** · 07/08/2016, 19h36

Envoyé par Philippe Tulliez

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub CopyPasteWithoutFormula_Ex3()
  Dim shtSource As Worksheet, wkbTarget As Workbook
  Dim File As String
  ' Sélection du classeur cible
  File = Application.GetOpenFilename("Fichiers Excel (Excel, *.xlsx", MultiSelect:=False)
  Select Case LCase(File)
    Case "false", "faux": Exit Sub
  End Select
  '
  Set shtSource = ThisWorkbook.Worksheets("Feuil1")
  Set wkbTarget = Workbooks.Open(File)
  '
  With wkbTarget
    shtSource.Copy Before:=.Sheets(1)
    With .Worksheets(1).UsedRange: .Value = .Value: End With
  End With
  ' ligne pour sauver le classeur cible
  Set shtSource = Nothing: Set wkbTarget = Nothing
End Sub

[EDIT]
Afin d'avoir une procédure plus "propre"
Il y a lieu de remplacer à la ligne 3, String par Variant. Soit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  Dim File As Variant

et remplacer les lignes 6, 7 et 8 par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
  On Error Resume Next
  If File = False Then Exit Sub
  On Error GoTo 0

Cela fonctionne, par contre est il possible de garder la mise en forme, le format, la largeur des colonnes etc?

a quoi sert cette ligne? Tu as noté ligne pour sauver le classeur cible mais je ne vois pas ce que tu veux dire?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  ' ligne pour sauver le classeur cible
  Set shtSource = Nothing: Set wkbTarget = Nothing

**Philippe Tulliez** · 07/08/2016, 20h32

Bonjour,

Cela fonctionne, par contre est il possible de garder la mise en forme, le format, la largeur des colonnes etc?

Manifestement, tu n'as pas tester la procédure ou tu l'as mal recopiée car le fait d'utiliser la méthode Copy de l'objet permet de tout conserver Format, Formule, Largeur de colonne, etc.
C'est la ligne With .Worksheets(1).UsedRange: .Value = .Value: End With qui transforme les formules par leur valeur

Tu as noté "ligne pour sauver le classeur cible" mais je ne vois pas ce que tu veux dire?

Cela signifie que lors de mon test, je n'ai pas sauver le classeur cible et que c'est donc toi qui doit l'écrire.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

myObject = Nothing

permet de libérer la mémoire allouée à un objet

**phoenix974** · 07/08/2016, 21h16

Je l'ai bien tésté mais lorsque la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With .Worksheets(1).UsedRange: .Value = .Value: End With

transforme les formules en valeur, cela supprime également toute la mise en forme.

**phoenix974** · 07/08/2016, 21h24

J'ai apparament resolu mon probleme en faisant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    'Declaration de la variable DerniereLigne et lui donne la valeur de la derniere ligne non vide de l'onglet DOC COMPTA et de la colonne C
    DerniereLigne = .Sheets(1).Range("D65536").End(xlUp).Row
    With .Worksheets(1).Range("D2:I" & DerniereLigne): .Value = .Value: End With

Je ne sais pas si c'est la méthode la plus efficace mais ca a l'air de fonctionner