Résolu Copier&coller des cellules d'1 fichier à 1autre si condition remplie

[fopy12]

Bonjour a tous
je souhaiterai une macro me permettant de:
Parcourir tous les fichiers se trouvant dans un dossier. Pour chaque fichier, si le contenu de la cellule G = « total de la semaine en cours », alors il faut copier les cellules H, I, J et K (de la même ligne que G). Puis il faudra les coller dans le thisworkbook et les coller dans les H, I, J et K si la G = « total de la semaine dernière ».

Est-ce possible ?
N’est-il pas plus simple de passer par un formulaire ?

Voici mon début de code qui me permet de parcourir les fichiers. En cherchant un peu sur ce forum même, j’ai trouvé cela et puis je l'ai adapté un peu.

Sub CopierCell()
    Dim FSO As New FileSystemObject
    Dim FichierALire As File
    
    Dim FichierSource As Workbook
    Dim FichierCible As Workbook
    Dim FeuilSource As Worksheet
    Dim FeuilCible As Worksheet
    Dim CellSource As Range
    Dim CellCible As Range
    Dim DernCellCible As Range
        
    Set FichierCible = ThisWorkbook
    
    For Each FichierALire In FSO.GetFolder("CHEMIN").Files
        ' Ne tenir compte que des fichiers xls
        If UCase(FichierALire.Name) Like "*.XLS" Then
            ' Ouvrir le fichier en lecture seule
            Set FichierSource = Workbooks.Open(FichierALire.Path, ReadOnly:=True)
            'On copie et on colle
            FichierSource.Worksheets(1).Cells().Copy Destination:=FichierCible.Worksheets(1).cells()'??????
    
            'On ferme le fichier source sans tenir compte d'éventuels changements?!
            FichierSource.Close SaveChanges:=False
        End If
   Next
End Sub

Merci d'avance

 

[zeb]

Salut,

Je ne vois pas dans ton code la transcription de

si le contenu de la cellule G = « total de la semaine en cours »

Et je ne vois pas d'information concernant la ligne, ni pour la source, ni pour la cible.

A la ligne 21, il faut se servir d'un Range() plutôt que d'un Cells().

 

[fopy12]

salut zeb, donc c'est possible mon truc
ça me rassure, je vais m'y re pencher alors

 

[zeb]

Evidemment que c'est possible. Tout est possible en programmation. VBA intègre VB tout de même ! Et VB peut accéder à toute l'API de Windows... Excuse du peu.

Puis-je t'aider ?

 

[fopy12]

Bon je vais réexpliquer mon problème pour être plus précise
J’extraits un fichier toutes les semaines. Je le nomme « AZER S19 » (.xls) puis je l’enregistre dans un dossier dans mes documents.
Dans ce fichier y’a des cellules que je voudrais copier. Ces cellules se trouvent en colonnes H, I, J et K mais à n’importe quelle ligne. Je m’explique ; par ex :
- mon fichier de la semaine 18 qui se nomme « AZER S18 » a ses cellules :
G… contient « Total de la semaine en cours »
H… contient « 8 000 »
I… contient « 3 000 »
J… contient « 2 500 »
K… contient « 1 500 »

- mon fichier de la semaine 19 qui se nomme « AZER S19 » a ses cellules :
G… contient « Total de la semaine en cours »
H… contient « 10 000 »
I… contient « 5 000 »
J… contient « 2 500 »
K… contient « 2 500 »

Mon fichier de la semaine 20 qui se nomme « AZER S20 » veut copier les cellules H…, I…, J… et K… du fichier « AZER S19 » et les coller à coté de la cellule G… qui contient « «Total de la semaine 19 ».
Et aussi copier les mêmes types de cellules du fichier « AZER S18 » et les coller à coté de la G… qui contient « Total de la semaine 18 ».
Ainsi de suite …

Jusque là, je n’ai réussi qu’à parcourir tous mes fichiers semestriels
1ere question : comment copier ces éléments et les coller ?
2eme : je pensais créer un fichier qui reprend tous ces éléments pour chaque fichier créé et qui sert de fichier transmission. N’est ce pas mieux ?

Zeb, lis le avec une boite de chocolat à coté de toi pour éviter une très forte migraine.

Sub CopierCell()
    Dim FSO As New FileSystemObject
    Dim FichierALire As File
    
    Dim i As Integer
    
    Dim FichierSource, FichierCible As Workbook
    Dim FeuilCible As Worksheet
    Dim CellSource, CellCible, DernCellCible As Range

    Set FichierCible = ThisWorkbook
    Set FeuilCible = ThisWorkbook.Worksheets(1)
    
    For Each CellCible In FeuilCible.Range("G2", FeuilCible.Cells(.Rows.Count, 7).End(xlRight))
    For Each FichierALire In FSO.GetFolder("chemin").Files
        ' Ne tenir compte que des fichiers xls
        If UCase(FichierALire.Name) Like "*.XLS" Then
            ' Ouvrir le fichier en lecture seule
            Set FichierSource = Workbooks.Open(FichierALire.Path, ReadOnly:=True)
            'On copie et on colle si G ="Total de la semaine en cours"
        For i = 2 To FichierSource.Worksheets(1).Cells(FichierSource.Worksheets(1).Rows.Count, 7).End(xlUp)
            If FeuilSource.Cells(i, 7).Text = "Total de la semaine en cours" Then
                Cells(i, 8).Copy Destination:=CellCible
            End If
        Next
            'Chercher la dernière cellule de la feuille source qui est la nouvelle cellule
            Set DernCellCible = FichierSource.Worksheets(1).Range(FichierSource.Worksheets(1).CellCible.Count, 7).End(xlRight)

            'On ferme le fichier source sans tenir compte d'éventuels changements?!
            FichierSource.Close SaveChanges:=False
        End If
   Next
   Next
End Sub

 

[oozenot]

salut fopy 12

ligne 23 défini la cellule plus précisément. et la copie peut se passer du "destination" :

[cpp]
If FeuilSource.Cells(i, 7).Text = "Total de la semaine en cours" Then
FeuilleSource.Cells(i, 8).Copy CellCible
End If
[/cpp]

Pour trouve ta cellule cible, tu utlise un range. si tes cellules de destinations ont la meme adresse, sert toi d' .Offset()

Je vais peut etre dire une betise mais pour copier il ne suffit peut etre pas d'ouvrir en read only. (point a vérifier..)

ligne 20 :
il faut que le texte de ta cellule "Total de la semaine" soit exact (majuscule/ minuscule/espaces...)

Je rajoute que tu ferais bien d'utiliser l' "OPTION EXPLICIT" sur chacune de tes feuilles VBA, ca t'aidera a repérer les erreurs de définitions des variables. (ligne 14 par exemple..)

 

[zeb]

Je suis d'accord avec Ooz' : On peut se passer de Destination:= dans Copy(), mais ça fixe les idées, effectivement, t'as dit une bêtise, il faut être exact et l'Option explicit est obligatoire !

 

[fopy12]

zeb et oozenot
j'avais mis le Option explicit, j'ai oublié de le copier. J'ai enlevé le "Destination"
:??:

 

[zeb]

Un extrait de code suffit amplement, et ajouter les noms des paramètres n'est pas une erreur en soit. Au contraire, les mettre ou pas devient un style d'écriture.

Dim FSO          As New FileSystemObject
Dim FichierALire As File
Dim i            As Integer
' // Pas bon. Il faut remettre le type après chaque variable !!!
' // Je te propose de ne pas confondre "Fichier" et "Classeur"
Dim FichierSource, FichierCible As Workbook
' // Pas bon. Il faut remettre le type après chaque variable !!!
Dim CellSource, CellCible, DernCellCible As Range
Dim FeuilCible   As Worksheet

' // Euh, t'en fait trop là, en fait ;^) Mais pourquoi pas.
Set FichierCible = ThisWorkbook
' // Soit tu en fais des tonnes et tu utilises ta variable, soit tu te contentes de ThisWorkbook
Set FeuilCible = ThisWorkbook.Worksheets(1)

' // Il manque un --chocolat-- un truc, là, non ?
' //                               ---------------------------v
For Each CellCible In FeuilCible.Range("G2", FeuilCible.Cells(.Rows.Count, 7).End(xlRight))
' // Si "chemin" est là pour nous faire comprendre sans avoir à dévoiler des données perso, tu as très bien fais ;^)
For Each FichierALire In FSO.GetFolder("chemin").Files
    If UCase(FichierALire.Name) Like "*.XLS" Then
        Set FichierSource = Workbooks.Open(FichierALire.Path, ReadOnly:=True)
        ' // Rholala ce que c'est lourd. Utilise une variable ou Un With.... Ou pas, t'as le droit de faire comme ça ;^)
        For i = 2 To FichierSource.Worksheets(1).Cells(FichierSource.Worksheets(1).Rows.Count, 7).End(xlUp)
            ' // Ca n'exite pas, FeuilSource.
            ' // Ou alors nous n'avons qu'un extrait,
            ' // Ou alors il manque l'Option Explicit et ton erreur est là. ET C'EST MAL !!!! >:^(
            If FeuilSource.Cells(i, 7).Text = "Total de la semaine en cours" Then
                Cells(i, 8).Copy CellCible
            End If
        Next
        ' // Ca sert à quoi ce truc ? Tu vas le fermer ce classeur
        Set DernCellCible = FichierSource.Worksheets(1).Range(FichierSource.Worksheets(1).CellCible.Count, 7).End(xlRight)
        FichierSource.Close SaveChanges:=False
    End If
Next
Next

Partout où il n'y a pas de vert, c'est que je ne trouve rien à redire

 

[fopy12]

Bonjour zeb
Apres quelques réctifications, voila ce que j'ai.
jecommence sérieusement à me facher apres VB :fou: mais bon comme c mon anniversaire today, j'arrive à me retenir

Option Explicit
Sub essai2()

Dim FSO          As New FileSystemObject
Dim FichierALire As File
Dim i            As Integer

' // -->Ok, J'ai mis le type après chaque variable
' // Je te propose de ne pas confondre "Fichier" et "Classeur"
'// -->ok c'est noté, mais je l'avoue je ne vois pas trop la différence : classeur pour excel et fichier = tout type?
Dim FichierSource As Workbook
Dim FichierCible As Workbook

'// -->Ok, J'ai mis le type après chaque variable
Dim CellSource As Range
Dim CellCible As Range

Dim FeuilCible  As Worksheet
Dim FeuilSource As Worksheet

'// --> j' en fais des tonnes et j'utilise ma variable :)
Set FichierCible = ThisWorkbook
Set FeuilCible = FichierCible.Worksheets(1)

' // Il manque un --chocolat-- un truc, là, non ?
'// --> Mais qu'est ce qui peut bien manquer par ici??? Peut etre ces 3 lignes suivants ???
With FichierCible.Worksheets(1)
    Set CellCible = .Range("G2", FeuilCible.Cells(.Rows.Count, 7).End(xlUp))
End With

For Each CellCible In FeuilCible
' // Si "chemin" est là pour nous faire comprendre sans avoir à dévoiler des données perso, tu as très bien fais ;^)
'//  --> OUI C'EST EXATEMENT CELA ;^)
For Each FichierALire In FSO.GetFolder("chemin").Files
    If UCase(FichierALire.Name) Like "*.XLS" Then
        Set FichierSource = Workbooks.Open(FichierALire.Path, ReadOnly:=True)
        With FichierSource.Worksheets(1)
             Set CellSource = .Range("G2", .Cells(65536, 7).End(xlUp))
        End With
        For Each FeuilSource In FichierSource
            If CellSource.Value = "Total de la semaine en cours" Then
                CellSource.Copy CellCible
            End If
        Next
        FichierSource.Close SaveChanges:=False
    End If
Next
Next
End Sub

Qu'en penses-tu?

 

[zeb]

Bon anniversaire.

Spoiler

Vous devez être connecté pour voir les images.

 

[zeb]

>> ok c'est noté, mais je l'avoue je ne vois pas trop la différence : classeur pour excel et fichier = tout type?

Le fichier est un truc sur disque, susceptible d'être ouvert par EXCEL si son extention est XLS

Dim FichierSource As File

Le classeur est un objet particulier en VB (ouvert par Excel, mais ça, c'est un détail).

Dim classeurSource As Workbook
Dim classeurCible As Workbook

Tu ne peux pas avoir une méthode qui commence par un point sans précision de l'objet sur lequel elle s'applique en dehors d'un With.

 

[fopy12]

Bon anniversaire.

Spoiler

Vous devez être connecté pour voir les liens.

mERCI

 

[fopy12]

ça ne marche toujours pas? Ou est le problème ? :fou:

Option Explicit
Sub essai3()

Dim FSO          As New FileSystemObject
Dim FichierALire As File
Dim i            As Integer

Dim FichierSource As Workbook
Dim FichierCible As Workbook

Dim CellSource As Range
Dim CellCible As Range

Dim FeuilCible  As Worksheet
Dim FeuilSource As Worksheet

Set FichierCible = ThisWorkbook
Set FeuilCible = FichierCible.Worksheets(1)

Set CellCible = FeuilCible.Range("G2", FeuilCible.Cells(.Rows.Count, 7).End(xlUp))

For Each CellCible In FeuilCible
For Each FichierALire In FSO.GetFolder("chemin").Files
    If UCase(FichierALire.Name) Like "*.XLS" Then
        Set FichierSource = Workbooks.Open(FichierALire.Path, ReadOnly:=True)
        With FichierALire.Worksheets(1)
             Set CellSource = .Range("G2", .Cells(65536, 7).End(xlUp))
        End With
        If CellSource.Value = "Total de la semaine en cours" Then
                CellSource.Offset(, 8).Value = CellCible.Offset(, 8).Text
        End If
        FichierSource.Close SaveChanges:=False
    End If
Next
Next
End Sub

Merci de ton aide!!

 

[zeb]

LIGNE 26. Rholala, je t'ai dit de ne pas confondre fichier et classeur exprès pour éviter ce genre d'erreur. Un fichier plein de 0 et de 1, ne contient pas de feuille.
Ce même fichier, s'il est ouvert par Excel, ça devient effectivement un classeur plein de feuilles et de cellules. Alors tu relis mon message précédent et tu t'en inspires.

Pis "ça marche pas", c'est pas suffisant !

M'enfin, si je vous dit de faire un truc ou un autre, ce n'est pas pour assouvir un besoin d'autorité mal placée. Ce ne sont pas des ordres que je vous donne, mais essayez quand même de les suivre. En plus, je me justifie à chaque fois quand je propose quelque chose

(Eh ben, heureusement que je t'ai "offert" des chocolats hier :/ )

---------------

Par ailleurs, l'ordre des For, lignes 22 et 23 ne me semble pas pertinent.

 

[fopy12]

ligne 26, j'ai compris l'erreur, j'ai corrigé.
sinon, le problème est que le code tourne bien, sans me signaler d'erreur. par contre je n'ai pas de résultats : je veux dire que je n'ai pas la valeur de cellsource dans cellvalue.
Voici mon nouveau code

Option Explicit
Sub essai3()

Dim FSO          As New FileSystemObject
Dim FichierALire As File
Dim i            As Integer

Dim FichierSource As Workbook
Dim FichierCible As Workbook

Dim CellSource As Range
Dim CellCible As Range

Dim FeuilCible  As Worksheet
'Dim FeuilSource As Worksheet

Set FichierCible = ThisWorkbook
Set FeuilCible = FichierCible.Worksheets(1)

Set CellCible = FeuilCible.Range("G2", FeuilCible.Cells(65536, 7).End(xlUp))

For Each FichierALire In FSO.GetFolder("Chemin").Files
    If UCase(FichierALire.Name) Like "*.XLS" Then
        Set FichierSource = Workbooks.Open(FichierALire.Path, ReadOnly:=True)
        With FichierSource.Worksheets(1)
             Set CellSource = .Range("G2", .Cells(65536, 7).End(xlUp))
        End With
        
        If CellCible.Text = "Total des retards de la semaine en cours" Then
            CellSource.Offset(, 8).Value = CellCible.Offset(, 8).Value
        End If
        
        FichierSource.Close SaveChanges:=False
    End If
Next
End Sub

 

[zeb]

A relire

Dim FSO          As New FileSystemObject
Dim FichierALire As File
'// Dim i            As Integer '// Inutile

Dim ClasseurSource As Workbook '// Je l'appelle classeur pour fixer les idées
Dim ClasseurCible As Workbook '// Pareil
Dim CellSource    As Range
Dim CellCible     As Range
Dim FeuilCible    As Worksheet
Dim FeuilSource   As Worksheet '// Ca, c'est nouveau, mais c'est pour faire symétrique

Set ClasseurCible = ThisWorkbook '// [CIBLE] Classeur
Set FeuilCible = ClasseurCible.Worksheets(1) '// [CIBLE] Feuille
Set CellCible = FeuilCible.Range("G2", FeuilCible.Cells(65536, 7).End(xlUp)) '// [CIBLE] Cellule

For Each FichierALire In FSO.GetFolder("Chemin").Files
    If UCase(FichierALire.Name) Like "*.XLS" Then
        Set ClasseurSource = Workbooks.Open(FichierALire.Path, ReadOnly:=True) '// [SOURCE] Classeur
        Set FeuilSource = ClasseurSource.Worksheets(1) '// [SOURCE] Feuille
        Set CellSource = FeuilSource.Range("G2", FeuilSource.Cells(65536, 7).End(xlUp)) '// [SOURCE] Cellule
        
        '// ???? T'es sûre qu'il faut lire la cible
        If CellCible.Text = "Total des retards de la semaine en cours" Then
            '// ???? T'es sûre qu'il faut écrire dans la source ?
            CellSource.Offset(, 8).Value = CellCible.Offset(, 8).Value
        End If
        
        ClasseurSource.Close SaveChanges:=False
    End If
Next

 

[fopy12]

'J'ai modifié ceci

        If CellSource.Text = "Total des retards de la semaine en cours" Then
            If CellCible.Text = "Total de la semaine dernière" Then ' //j'ai ajouté une nouvelle condition
                CellCible.Offset(, 8).Value = CellSource.Offset(, 8).Value
            End If
        End If

et toujours rien , je suis désespérée :??:

 

[zeb]

....

Barde ton code de MsgBox pour savoir par où il passe.
Exemple :

For Each FichierALire In FSO.GetFolder("Chemin" ).Files
    If UCase(FichierALire.Name) Like "*.XLS" Then
        Set ClasseurSource = Workbooks.Open(FichierALire.Path, ReadOnly:=True)
        Set FeuilSource = ClasseurSource.Worksheets(1)
        Set CellSource = FeuilSource.Range("G2", FeuilSource.Cells(65536, 7).End(xlUp))
        MsgBox "J'ouvre le fichier '" & FichierALire.Name & "'" & vbCrLf &
               "et je m'intéresse à la plage " & CellSource.Address
        If CellSource.Text = "Total des retards de la semaine en cours" Then
            MsgBox "La cellule " & CellSource.Address & " contient 'Total des retards...'" & vbCrLf & 
                   "Je m'apprête à copier la cellule " & CellSource.Offset(, 8).Address & " dans la cellule " & CellCible.Offset(, 8).Address
            CellCible.Offset(, 8).Value  = CellSource.Offset(, 8).Value
        End If
        ClasseurSource.Close SaveChanges:=False
    End If
Next

EDIT: Et bien juste en écrivant ces MsgBox, on s'aperçoit qu'on définit une plage à la ligne 5, et non pas une cellule. Il faut la parcourir cette la plage !

For Each FichierALire In FSO.GetFolder("Chemin" ).Files
    If UCase(FichierALire.Name) Like "*.XLS" Then
        Set ClasseurSource = Workbooks.Open(FichierALire.Path, ReadOnly:=True)
        Set FeuilSource = ClasseurSource.Worksheets(1)
        Set cellules_S = FeuilSource.Range("G2", FeuilSource.Cells(65536, 7).End(xlUp))
        MsgBox "J'ouvre le fichier '" & FichierALire.Name & "'" & vbCrLf &
               "et je m'intéresse à la plage " & cellules_S.Address
        For Each cellSource In cellules_S
            If CellSource.Text = "Total des retards de la semaine en cours" Then
                MsgBox "La cellule " & CellSource.Address & " contient 'Total des retards...'" & vbCrLf & 
                       "Je m'apprête à copier la cellule " & CellSource.Offset(, 8).Address & " dans la cellule " & CellCible.Offset(, 8).Address
                CellCible.Offset(, 8).Value  = CellSource.Offset(, 8).Value
            End If
        Next
        ClasseurSource.Close SaveChanges:=False
    End If
Next

 

[fopy12]

je crois avoir trouvé le soucis.
en fait il copie la bonne valeur dans le classeur source. par contre il ne la colle pas à la bonne cellule dans le classeurcible.
a la place, il la colle dans toute la plage : I2 jusqu'à la dernière cellule active de la colonne I. comment lui faire savoir qu'il faut coller la valeur copiée à coté de la cellule contenant "Total de la semaine dernière"?
Merci d'avance