Copy/paste de range (valeur)

Acturis

XLDnaute Nouveau
Bonjour à tous,

Une fois de plus je viens vers vous pour un petit problème que je rencontre dans une macro.
J'aimerais copier/coller des ranges, mais uniquement les valeurs (pour ne pas modifier les mises en forme conditionnelles de la destination).

Pour ce faire j'ai tenté ce code, mais un message d'erreur apparaît :

VB:
Sub Convert()


Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim Fichier As Variant

'Recherche du fichier
Fichier = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
  
If Fichier <> False Then 'Si on n'a pas cliqué sur "Annuler"
    Workbooks.Open Filename:=Fichier 'Ouverture du fichier
    NomFichier = Dir(Fichier) 'Nom du fichier sans le chemin

        With Workbooks(NomFichier) 'Avec le fichier que l'on vient d'ouvrir
                           
                'Copie de l'onglet Data
                Worksheets("Data").Activate
                Worksheets("Data").Range("A2:BB1000").Select
               
                'Copie de la sélection dans le fichier actuel
                Selection.Copy ThisWorkbook.Sheets("DATA").Range("A2").Value
               
                'Copie de l'onglet Toto
                Worksheets("Toto").Activate
                Worksheets("Toto").Range("B6:B505").Select
                Selection.Copy ThisWorkbook.Sheets("Toto").Range("B6").Value

etc...

Application.DisplayAlerts = True
       
End If
End Sub

Je pense que le problème vient du ".Value" que j'ai rajouté sur chaque ligne de copie....
Le message qui s'affiche est le suivant "La methode copy de la classe Range a échoué."

Auriez vous une idée pour résoudre ce problème ?

Merci d'avance !!
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Acturis, bonjour le forum,

Peut-être comme ça :

VB:
Sub Convert()
Dim Fichier As Variant
Dim CS As Workbook
Dim CD As Workbook
Dim OS As Worksheet
Dim OD As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set OD = ThisWorkbook

'Recherche du fichier
Fichier = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
If Fichier <> False Then 'Si on n'a pas cliqué sur "Annuler"
    Workbooks.Open Filename:=Fichier 'Ouverture du fichier
    Set CS = ActiveWorkbook
    Set OS = CS.Worksheets("Data")
    Set OD = CD.Worksheets("Data")
    OS.Range("A2:BB1000").Copy
    OD.Range("A2").PasteSpecial (xlPasteValues)
              
    Set OS = CS.Worksheets("Toto")
    Set OD = CD.Worksheets("Toto")
    OS.Range("B6:BB1000").Copy
    OD.Range("B6").PasteSpecial (xlPasteValues)
   
    'etc...
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End If
End Sub
 

Acturis

XLDnaute Nouveau
Bonjour Acturis, bonjour le forum,

Peut-être comme ça :

VB:
Sub Convert()
Dim Fichier As Variant
Dim CS As Workbook
Dim CD As Workbook
Dim OS As Worksheet
Dim OD As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set OD = ThisWorkbook

'Recherche du fichier
Fichier = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
If Fichier <> False Then 'Si on n'a pas cliqué sur "Annuler"
    Workbooks.Open Filename:=Fichier 'Ouverture du fichier
    Set CS = ActiveWorkbook
    Set OS = CS.Worksheets("Data")
    Set OD = CD.Worksheets("Data")
    OS.Range("A2:BB1000").Copy
    OD.Range("A2").PasteSpecial (xlPasteValues)
              
    Set OS = CS.Worksheets("Toto")
    Set OD = CD.Worksheets("Toto")
    OS.Range("B6:BB1000").Copy
    OD.Range("B6").PasteSpecial (xlPasteValues)
   
    'etc...
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End If
End Sub

Bonjour Robert,

Merci pour votre réponse.
Je viens d'essayer avec votre code, et j'ai un bug au niveau du "Set OD = ThisWorkbook".

VB:
Sub Convert()

Dim Fichier As Variant
Dim CS As Workbook
Dim CD As Workbook
Dim OS As Worksheet
Dim OD As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set OD = ThisWorkbook

'Recherche du fichier
Fichier = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
  
If Fichier <> False Then 'Si on n'a pas cliqué sur "Annuler"
    Workbooks.Open Filename:=Fichier 'Ouverture du fichier
    NomFichier = Dir(Fichier) 'Nom du fichier sans le chemin

        With Workbooks(NomFichier) 'Avec le fichier que l'on vient d'ouvrir
                           
                'Copie de l'onglet Data
                Set CS = ActiveWorkbook
                Set OS = CS.Worksheets("Data")
                Set OD = CD.Worksheets("Data")
                OS.Range("A2:BB1000").Copy
                OD.Range("A2").PasteSpecial (xlPasteValues)
   
                               
                'Copie de l'onglet Toto
               
                Set OS = CS.Worksheets("Toto")
                Set OD = CD.Worksheets("Toto")
                OS.Range("B6:B505").Copy
                OD.Range("B6").PasteSpecial (xlPasteValues)

Comprenez-vous ce blocage ?

Merci encore
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG