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

Salut,

Je ne vois pas dans ton code la transcription de 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().

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

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 ?

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

salut fopy 12

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

If FeuilSource.Cells(i, 7).Text = "Total de la semaine en cours" Then

    FeuilleSource.Cells(i, 8).Copy CellCible

End If

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

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 !

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

 
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  

Bonjour zeb
Apres quelques réctifications, voila ce que j'ai.
jecommence sérieusement à me facher apres VB   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?

Bon anniversaire.

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

mERCI
 

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

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

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.

 
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

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

 
'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  

....

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

 
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

 
ca marche, Peut etre c'est mal écrit...??
maintenant je dois tester sur plusieurs fichiers. je crois que ca doit etre le même principe , non?

Option Explicit

Sub essai5()

 
Dim FSO          As New FileSystemObject

Dim FichierALire As File

 
Dim ClasseurSource As Workbook

Dim ClasseurCible As Workbook

Dim CellSource    As Range

Dim CellCible    As Range

Dim cellules_S As Range

Dim cellules_F As Range

Dim FeuilCible    As Worksheet

Dim FeuilSource  As Worksheet

 
Set ClasseurCible = ThisWorkbook

Set FeuilCible = ClasseurCible.Worksheets(1)

Set cellules_F = 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 ClasseurSource = Workbooks.Open(FichierALire.Path, ReadOnly:=True)

    Set FeuilSource = ClasseurSource.Worksheets(1)

    Set cellules_S = FeuilSource.Range("G2", FeuilSource.Cells(65536, 7).End(xlUp))

        For Each CellSource In cellules_S

            If CellSource.Text = "Total des retards de la semaine en cours" Then

                For Each CellCible In cellules_F

                    If CellCible = "Total de la semaine dernière" Then

                    CellCible.Offset(, 1).Value = CellSource.Offset(, 1).Value

                    CellCible.Offset(, 2).Value = CellSource.Offset(, 2).Value

                    CellCible.Offset(, 3).Value = CellSource.Offset(, 3).Value

                    CellCible.Offset(, 4).Value = CellSource.Offset(, 4).Value

                    End If

                Next

            End If

        Next

        ClasseurSource.Close SaveChanges:=False

    End If

Next

 
End Sub

Ahhhhh  
Voilà qui est très bien.

On peut toujours faire des remarques si on cherche bien :

L'indentation n'est pas parfaite.

Je trouve le nom cellules_F peu pertinent. Il s'agit de l'ensemble des cellules utile de la colonne G de la feuille cible. Alors autant l'appeler ColonneGCible ou un truc comme ça. Si tu as une logique pour justifier le F, pani pwoblem.

Les lignes 29 à 32 sont identiques. Pour 4 lignes, c'est du luxe, mais on peut quand même écrire :

For i = 1 To 4

    CellCible.Offset(, i).Value = CellSource.Offset(, i).Value

Next

Comment ça je pinaille ???   ...

non tu ne pinaille pas, tas surement raison
j'ai mis F sans réfléchir c'était au pif, je vais le changer car dans une semaine je vais me demander qu'est ce que c'est  
Merci encore

Meilleure réponse sélectionnée par fopy12.