Excel VBA copier cellules avec formules
r4944
Messages postés
136
Statut
Membre
-
r4944 Messages postés 136 Statut Membre -
r4944 Messages postés 136 Statut Membre -
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
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. |
1 réponse
-
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-
-
- 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...
-
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
-
