Code VBA Copier Collage spéciale en valeur (sans formule) Fermé

Question

Bonjour, 

J'essai d'adapter le code ci dessous afin de faire un collage spécial des valeurs de la colonne de départ sans copier les formules. Et pour l'instant je galère depuis plusieurs heures.
Pour moi le code qu'il faut modifier est:    .Columns(Col).Copy WbkColle.Sheets("Commande").Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 1)


Sub ImporterBudget()
Dim Fichier, WbkCopy As Workbook, WbkColle As Workbook
Dim Colonnes(), Col As Integer, Resultat As Variant

  'On attribue à la variable WbkColle le fichier actuel (celui qui contient la macro)
  Set WbkColle = ThisWorkbook
    'Nom des entêtes de colonnes à importer
  Colonnes = Array("Code nana", "Métier", "Produit", "Client")
    'Sélection du fichier
  Fichier = Application.GetOpenFilename("Fichiers Excels, *.xls*")
  'En cas de clic sur "ANNULER"
    If Fichier <> False Then
    'On ouvre le fichier en question
    Set WbkCopy = Workbooks.Open(Fichier)
    
        With WbkCopy.Sheets("Import")
    'Boucle sur toutes les entêtes des colonnes
            For Col = 1 To .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
             'teste si l'entête correspond à un des noms des colonnes à copier
             Resultat = Application.Match(.Cells(1, Col), Colonnes, 0)
             'Si l'entête est trouvée (colonne à copier)
                If Not IsError(Resultat) Then
                'Copié - Collé ==> ADAPTER NOM de la feuille ou il faut coller
                  .Columns(Col).Copy WbkColle.Sheets("Commande").Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 1)

                End If
            Next Col
        End With

WbkCopy.Close
    End If
Set WbkCopy = Nothing
Set WbkColle = Nothing
End Sub



Configuration: Windows 7 / Mozilla 11.0

ThauTheme · Answer

Bonjour Sphynxitos, bonjour le forum,

Essai comme ça :

.Columns(Col).Copy 
WbkColle.Sheets("Commande").Cells(1, WbkColle.Sheets("Commande").Cells.Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial(xlPasteValues) 

Mais avec deux variables de plus c'est tellement plus simple à coder :
Sub ImporterBudget()
Dim Fichier
Dim CY As Workbook 'déclare la variable CY (Classeur copY)
Dim OY As Worksheet 'déclare la variable OY (Onglet copY)
Dim CE As Workbook 'déclare la variable CE (Classeur collE)
Dim OE As Worksheet 'déclare la variable OE (Onglet collE)
Dim Colonnes(), Col As Integer, Resultat As Variant

'On attribue à la variable CE le fichier actuel (celui qui contient la macro)
Set CE = ThisWorkbook
Set OE = CE.Sheets("Commande")
'Nom des entêtes de colonnes à importer
Colonnes = Array("Code nana", "Métier", "Produit", "Client")
'Sélection du fichier
Fichier = Application.GetOpenFilename("Fichiers Excels, *.xls*")
'En cas de clic sur "ANNULER"
If Fichier <> False Then
    'On ouvre le fichier en question
    Set CY = Workbooks.Open(Fichier)
    Set OY = CY.Sheets("Import")
        'Boucle sur toutes les entêtes des colonnes
        For Col = 1 To OE.Cells(1, OE.Cells.Columns.Count).End(xlToLeft).Column
            'teste si l'entête correspond à un des noms des colonnes à copier
            Resultat = Application.Match(OE.Cells(1, Col), Colonnes, 0)
            'Si l'entête est trouvée (colonne à copier)
            If Not IsError(Resultat) Then
            'Copié - Collé ==> ADAPTER NOM de la feuille ou il faut coller
                OE.Columns(Col).Copy
                OY.Cells(1, OY.Cells.Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial (xlPasteValues)
            End If
        Next Col
    End With
    CY.Close
End If
End Sub

Code VBA Copier Collage spéciale en valeur (sans formule)

1 réponse

Discussions similaires