Excel VBA copier cellules avec formules

Fermé
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017 - Modifié par baladur13 le 17/05/2016 à 16:38
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017 - 17 mai 2016 à 17:37
Bonjour,

J'ai une macro qui me permet d'importer des donnees d'une feuille Excel vers la feuille active (qui contienne la macro) , le problème c'est que j'ai réussi à faire seulement le transfert des donnees », mias les formules ne sont pas importées ce qui pose un problème parce que nous devons souvent modifier les données après. Sans les formules, nous devons faire les calculs manuellement ce qui laisse place à des erreurs.

voici mon code 



Option Explicit
Option Base 1
'--------
Sub Importdatav2()
Dim Source As Workbook, Dercol As Integer
Dim Nbre As Integer, Tablo, Cptr As Integer, derlig As Integer, Lig As Integer, Col As Integer
Dim FichiersAOuvrir, I As Integer

  Application.ScreenUpdating = False



  FichiersAOuvrir = Application.GetOpenFilename(, , , , True)
  If IsArray(FichiersAOuvrir) Then
    For I = LBound(FichiersAOuvrir, 1) To UBound(FichiersAOuvrir, 1)
      Set Source = Application.Workbooks.Open(FichiersAOuvrir(I), , True)
      With Sheets("Workload - Charge de travail")
       Dercol = Cells(2, Columns.Count).End(xlToLeft).Column
        Nbre = Application.CountIf(.Columns("AQ"), "XX")
        ReDim Tablo(Nbre, Dercol)
        Lig = 1
        For Cptr = 1 To Nbre
          Lig = .Columns("AQ").Find("XX", .Cells(Lig, "AQ"), xlValues).Row
          For Col = 1 To Dercol
            Tablo(Cptr, Col) = .Cells(Lig, Col)
          Next Col
        Next Cptr
      End With
      Source.Close False
      
 With ThisWorkbook.Sheets("Sheet1")
        derlig = .Range("A" & Rows.Count).End(xlUp).Row + 1 'premiere cellules vide colonne A
        .Range("A" & derlig).Resize(Cptr, Dercol) = Tablo
        '.Activate
     End With
      
      
      
      
    Next I
  Else
    MsgBox "Aucun choix"
  End If
End Sub



EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.
A voir également:

1 réponse

Réponse 1 / 1
jordane45 Messages postés 38469 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 22 avril 2025 4 741
Modifié par jordane45 le 17/05/2016 à 16:47
Bonjour,

Essayes de mettre .formulaLocal
A la ligne : 
Tablo(Cptr, Col) = .Cells(Lig, Col)


Comme ceci : 
Tablo(Cptr, Col) = .Cells(Lig, Col).formulalocal




Cordialement, 
Jordane                                                                 
1
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017
17 mai 2016 à 17:06
Merci Beaucoup Jordane :) , mais ça copie pas pour les mises en formes conditionnelles

exemple : de mettre en évidence des cellules qui manquent des données (en orange), des cellules qui ne requirent pas de données (en noir),
0
jordane45 Messages postés 38469 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 22 avril 2025 4 741 > r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017
17 mai 2016 à 17:10
Ah ben non...
Ca copie le CONTENU de la cellule.
Pour copier les MFC ... tu ne peux pas utiliser ce code ...
0
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017
17 mai 2016 à 17:10
Voici ce que j'ai essayé de faire 


Tablo(Cptr, Col) = .Cells(Lig, Col).FormulaLocal.FormatCoditions
0
jordane45 Messages postés 38469 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 22 avril 2025 4 741 > r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017
17 mai 2016 à 17:15
FormatCoditions est une méthode de RANGE ... pas de FORMULALOCAL
https://docs.microsoft.com/fr-fr/office/vba/api/excel.formatcondition?redirectedfrom=MSDN


Il te faut récupérer les deux informations (la valeur/formule et la MFC ...) séparément...
0
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017
17 mai 2016 à 17:37
Re , ça devrait fonctionner de cette façon 

Option Explicit
Option Base 1
'--------
Sub Importdatav2()
Dim Source As Workbook, Dercol As Integer
Dim Nbre As Integer, Tablo, Cptr As Integer, derlig As Integer, Lig As Integer, Col As Integer
Dim FichiersAOuvrir, I As Integer

  Application.ScreenUpdating = False



  FichiersAOuvrir = Application.GetOpenFilename(, , , , True)
  If IsArray(FichiersAOuvrir) Then
    For I = LBound(FichiersAOuvrir, 1) To UBound(FichiersAOuvrir, 1)
      Set Source = Application.Workbooks.Open(FichiersAOuvrir(I), , True)
      With Sheets("Workload - Charge de travail")
       Dercol = Cells(2, Columns.Count).End(xlToLeft).Column
        Nbre = Application.CountIf(.Columns("AQ"), "XX")
        ReDim Tablo(Nbre, Dercol)
        Lig = 1
        For Cptr = 1 To Nbre
          Lig = .Columns("AQ").Find("XX", .Cells(Lig, "AQ"), xlValues).Row
          For Col = 1 To Dercol
          
          With FichiersAOuvrir.Range("A:AP").FormatConditions(1)
        With .Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 6
    End With
    With .Font
        .Bold = True
        .ColorIndex = 3
    End With
End With
          
            Tablo(Cptr, Col) = .Cells(Lig, Col).FormulaLocal
          Next Col
        Next Cptr
      End With
      Source.Close False
      
 With ThisWorkbook.Sheets("Sheet1")
        derlig = .Range("A" & Rows.Count).End(xlUp).Row + 1 'premiere cellules vide colonne A
        .Range("A" & derlig).Resize(Cptr, Dercol) = Tablo
        '.Activate
     End With
      
      
      
      
    Next I
  Else
    MsgBox "Aucun choix"
  End If
End Sub
0