Consolider plusieurs fichiers / somme

[domb]

Bonjour à tous

J'ai un besoin d'aide concernant le code suivant.
Je m'en sert déjà pour alimenter un tableau (par rajout de ligne).
Pour une autre appli, Je souhaiterais le modifier pour qu'il fasse la somme des lignes souhaitées et non qu'il aille me recopier à la suite des autres les lignes demandées.

Faut-il juste remplacer le ".Value" par ".Sum" ?

Code :

'récupère dans une série de classeurs fermés (dans le même répertoire)
'les valeurs d'une plage et les écrit dans la feuille active

Sub LoopThruFiles()
Dim place As String
Dim FilesArray() As String, FileCounter As Integer
Dim FName As String, LoopCounter As Integer

FName = Dir("H:\...\*.XLS")
Do While Len(FName) > 0
FileCounter = FileCounter + 1
ReDim Preserve FilesArray(1 To FileCounter)
FilesArray(FileCounter) = FName
FName = Dir()

Loop
If FileCounter > 0 Then
Application.ScreenUpdating = False
For LoopCounter = 1 To FileCounter

x = LoopCounter
'calcul de la plage de destination
place = Range(Cells((x + 7), 2), Cells((x + 7), 19)).Address
GetValues "H:\...",
FilesArray(LoopCounter), "Feuil1", "N142:AE142", place
Next
Application.ScreenUpdating = True
End If
End Sub

Sub GetValues(fPath As String, FName As String, sName, _
cellRange As String, place As String)
'recopie une plage des valeurs externes dans une plage de
'la feuille active sous forme d'une formule matricielle
With ActiveSheet.Range(place)
.FormulaArray = "='" & fPath & "\[" & FName & "]" & sName & "'!" & cellRange
.Value = .Value
End With
End Sub

Merci pour votre aide

 

[Compte Supprimé 979]

Re : Consolider plusieurs fichiers / somme

Salut Domb,

Tu peux essayer un code par connexion ADO

Code pour lancer la fonction

Sub Test()
  ActiveSheet.Range("A1") = SumWithADO("MonChemin", "MonFichier.xls", "NomFeuille", "Plage", NumCol_Aditionner)
End Sub

Code de la fonction

Function SumWithADO(fPath As String, fName As String, sName, cellRange As String, SumCol As Integer)
  Dim myConn As ADODB.Connection, myCmd As ADODB.Command, myRS As ADODB.Recordset
  Dim VPathFic As String
  Dim I As Long, SumRng As Double
  ' Construction du chemin d'accès
  If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
  VPathFic = fPath & fName
  ' Ouverture de la connexion et du recordset
  Set myConn = New ADODB.Connection
  myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & VPathFic & ";" & _
              "Extended Properties=""Excel 8.0;HDR=No;IMEX=1;"""
  Set myCmd = New ADODB.Command
  myCmd.ActiveConnection = myConn
  myCmd.CommandText = "SELECT * from [" & sName & "$" & cellRange & "]"
  Set myRS = New ADODB.Recordset
  myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
  ' Mettre à zéro la variable
  SumRng = 0
  ' Se positionner sur le premier enregistrement
  myRS.MoveFirst
  ' Restituer les données
  For I = 1 To myRS.RecordCount
    SumRng = SumRng + myRS(SumCol - 1)
    ' Enregistrement suivant
    myRS.MoveNext
  Next I
  ' Renvoyer la valeur à la fonction
  SumWithADO = SumRng
  ' Fermer la connection
  myConn.Close
  Set myRS = Nothing
  Set myCmd = Nothing
  Set myConn = Nothing
End Function

Je ne sais pas si cela peut correspondre à ta demande, mais ça fonctionne très bien pour moi

A+

 

[domb]

Re : Consolider plusieurs fichiers / somme

J'ai modifier le sub test comme suivant

Sub Test()
ActiveSheet.Range("A1") = SumWithADO("H:\...\", "*.xls", "Feuil1", "N69:AW69", NumCol_Aditionner)
End Sub

ça bloque au niveau du "NumCol_Aditionner" ?
Je souhaite additionner des lignes reprises par "N69:AW69"
est-ce qu'il mettre une autre variable (numéro de colonne ?)?

 

[domb]

Re : Consolider plusieurs fichiers / somme

Le message d'erreur suite au blocage est "type d'argument byref incompatible"

Avez-vous une idée ?

 

[Compte Supprimé 979]

Re : Consolider plusieurs fichiers / somme

Salut Domb,

Tu ne peux pas mettre ce genre d'argument pour le chemin d'accès, ni pour le nom de fichier !

Tu peux essayer dans ta boucle For Next

Loop
If FileCounter > 0 Then
Application.ScreenUpdating = False
For LoopCounter = 1 To FileCounter
x = LoopCounter
'calcul de la plage de destination
place = Range(Cells((x + 7), 2), Cells((x + 7), 19)).Address
GetValues "H:\...", 
FilesArray(LoopCounter), "Feuil1", "N142:AE142", place
Range([COLOR=red]??[/COLOR]).value = SumWithADO("H:\MonChemin\", FilesArray(LoopCounter), "Feuil1", "N142:AE142", NumCol_Aditionner)
Next
Application.ScreenUpdating = True
End If
End Sub

A+

 

[domb]

Re : Consolider plusieurs fichiers / somme

Re bonjour

J'ai essayé dans la boucle for next mais sans succés

Je seche completement d'autant plus que je ne suis pas un pro de VBA.

Qu'est ce qui serait à modifier dans le code de mon premier post pour faire la Somme des cellules voulues et non la recopie ?

Merci de votre aide

 

[domb]

Re : Consolider plusieurs fichiers / somme

Bonjour à tout le forum

Pour finir, j'ai finalement fait des essais en important dans une feuille et en faisant les calculs dans une autre. Et ça fonctionne très bien.

Le code via ADO est à user voire même abuser pour ceux que cela intéresse car la remonter des données est très très rapide et ne nécessite pas d'ouvrir les fichiers.

Good luck à tous et bon week