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:

Excel VBA copier cellules avec formules
Formule excel pour additionner plusieurs cellules - Guide
Liste déroulante excel - Guide
Formule excel - Guide
Verrouiller cellules excel - Guide
Aller à la ligne dans une cellule excel - Guide

1 réponse

Réponse 1 / 1

jordane45 Messages postés 38178 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 16 mai 2024 4 668
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

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),

jordane45 Messages postés 38178 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 16 mai 2024 4 668 > 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 ...

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

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...

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

Discussions similaires

Dessiner avec son clavier et avec des lettres

recopier une formule sans décalage

Discussions similaires

Newsletters