Discussion :

[stroutz]

Bonjour,

Après plusieurs recherches et tests… Je baisse les bras.

Je souhaiterais, par un bouton sur une userform effectuer la tâche suivante :
J’ai un fichier contenant des données de la colonne A à D sur un nombre de ligne différent suivant les extractions que je fais.

J’aimerais que :

SI -colonne A- contient « nom1 », alors il copie chaque ligne, (de A à D) contenant « nom1 » dans un autre fichier excel nommé « nom1 » à un emplacement et sur une feuille précise.
Si –colonne A- contient « nom2 », alors il copie chaque ligne, (de A à D) contenant « nom2 » dans un autre fichier excel nommé « nom2 » à un emplacement et sur une feuille précise.
Si –colonne A- contient « nom3 », alors il copie chaque ligne, (de A à D) contenant « nom3 » dans un autre fichier excel nommé « nom3 » à un emplacement et sur une feuille précise.
Etc…. (…)
Si –colonne A- contient « nom70 », alors il copie chaque ligne, (de A à D) contenant « nom70 » dans un autre fichier excel nommé « nom70 » à un emplacement et sur une feuille précise.

Je précise que les fichiers de destination sont déjà créés pour correspondre exactement à la donnée qui pourrait se trouver dans la colonne A.

Pistes : Déjà il faut faire une boucle qui consulte les données de la colonne A. En effet, lors de l’extraction, cette colonne peut comprendre des valeurs différentes (nom1, nom5, nom7 par exemple) et en même temps.

[Daniel.C]

Bonjour,

J'ai supposé que les classeurs cibles se trouvaient dans le même dossier que le classeur source :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
    Dim Plage As Range, Dico As Object, C As Range
    Set Dico = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Sheets("Feuil1")
        Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
        For Each C In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
                .AutoFilterMode = False
                Plage.AutoFilter 1, C.Value
                Plage.Offset(1).Resize(Plage.Rows.Count - 1, 4).SpecialCells(xlCellTypeVisible).Copy
                Set wbk = Workbooks.Open(ThisWorkbook.Path & "\" & C.Value)
                wbk.Sheets(1).[B100].PasteSpecial xlPasteValues
            End If
        Next C
        .AutoFilterMode = False
    End With
End Sub

[stroutz]

Merci pour la réponse très rapide je vais tester cela dès à présent! Non les fichiers de destination ne sont pas dans le même dossier

Merci pour le code, il est hyper intéressant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub CommandButton6_Click()

    Dim Plage As Range, Dico As Object, C As Range
    
    Set Dico = CreateObject("Scripting.Dictionary")

'J'active le fichier dans lequel il faut prélever les infos
   
Windows("Receivables May.xls").Activate

'Il n'y a qu'une seule feuille dans ce classeur, le nom peut varier suivant les extractions donc j'utilise seulement "ThisWorksheet"

    With ThisWorksheet
        Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
        For Each C In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
                .AutoFilterMode = False
                Plage.AutoFilter 1, C.Value
                Plage.Offset(1).Resize(Plage.Rows.Count - 1, 4).SpecialCells(xlCellTypeVisible).Copy
           'J'y ai inseré le repertoire ou sont stocké les différents fichiers Excel     Set wbk = Workbooks.Open(ThisWorkbook.Path & "D:\Documents and ........ Reconciliation File" & C.Value)
              'Chaque extractions et copier/coller devra être insérer dans une feuille correspondant à un mois précis, une liste déroulante intégrant donc 12 mois a été créée
wbk.Sheets(ComboBox2.Value).[A68].PasteSpecial xlPasteValues
            End If
        Next C
        .AutoFilterMode = False
    End With


End Sub

Le code saute au niveau de l'écriture jaune...


Pas besoin de me conseiller de suite si tu n'as pas le temps, je vais regarder de mon côté !


Mais merci déjà pour ta première et très intéressante ébauche!!

[Daniel.C]

Remplace "ThisWorksheet" qui n'est pas un mot VBA par ActiveSheet".

[stroutz]

C'est trop bête... ça marchait comme sur des roulettes jusqu'à ce que

"error 1004"
La méthode PasteSpecial de la classe Range a échoué:



Je vais voir quoi faire... Et j'ai trouvé pour le format de destination c'est bon

[Daniel.C]

A priori, il manque l'instruction d'ouverture du classeur.

[stroutz]

MMh je ne crois pas...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub CommandButton6_Click()

'COMMANDE POUR LOADER AUTOMATIQUEMENT TOUTES LES ***

    Dim Plage As Range, Dico As Object, C As Range
    
    Set Dico = CreateObject("Scripting.Dictionary")

'J'active le fichier dans lequel il faut prélever les infos
   
Windows("***.xls").Activate



    With ActiveSheet
        Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
        For Each C In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
                .AutoFilterMode = False
                Plage.AutoFilter 1, C.Value
                Plage.Offset(1).Resize(Plage.Rows.Count - 1, 4).SpecialCells(xlCellTypeVisible).Copy
'J'y ai inseré le repertoire ou sont stocké les différents fichiers Excel
           Set wbk = Workbooks.Open(ThisWorkbook.Path & "\" & ComboBox3.Value & "\I. **************\" & C.Value & ".xls")
'Chaque extraction et copier/coller devra être insérer dans une feuille correspondant à un mois précis, une liste déroulante intégrant donc 12 mois a été créée

wbk.Sheets(ComboBox2.Value).[A68].PasteSpecial xlPasteValues
            End If
        Next C
        .AutoFilterMode = False
    End With


End Sub

Et boum erreur de la PasteSpecial systématique.... Alors que le fichier s'ouvre correctement, sur la bonne feuille, la bonne cellule est sélectionnée pour le collage des données

[Daniel.C]

Je faisais allusion à ton post de 13:50. Vérifie si la feuille est protégée. Sinon, place l'ouverture avant l'instruction "Copy".