Macro buguée ?

Le 28/02/2016 à 20:46

Bonsoir à toutes et à tous,

Je passe par ce forum ce soir car j'aurai besoin d'un œil expert afin de tenter de débloquer ma situation de novice.

En effet, j'ai constitué une petite macro mais celle-ci refuse de poursuivre son but :

En gros, je lance celle-ci d'un classeur A et doit théoriquement me demander d'aller chercher sur mon PC ou autre lecteur réseau un classeur B.

A l'ouverture de ce dernier, elle doit filtrer 3 colonnes dans un onglet (appelé suivi dans mon code) sur 3 critères différents, copier certaines colonnes (pas celles filtrer précédemment) et les recopier sur le classeur A d'où j'ai lancé la macro.

Seulement voilà, le fichier B s'ouvre et là rien ne se passe....

Sauriez vous me dépanner de cette macro incomplète ?

Merci beaucoup à tout ceux qui se pencheront sur mon soucis.

Sub Suivi_()
'
' 

Dim shSUIVI

    nom = ActiveWorkbook.Name
    Set shSUIVI = Workbooks(nom).Worksheets("Feuil1")

        Call MaProcedure

        'sortie si pas de fichier
        If NomFichier = "" Then Exit Sub

With Workbooks(NomFichier).Worksheets("Suivi")

    ActiveSheet.ShowAllData

    ActiveSheet.Range("$A$9:$IB$9467").AutoFilter Field:=14, Criteria1:="SIGNE"
    ActiveSheet.Range("$A$9:$IB$9467").AutoFilter Field:=6, Criteria1:="Déployé"
    ActiveSheet.Range("$A$9:$IB$9467").AutoFilter Field:=113, Criteria1:="="

    'sélectionne les cellules à coller
    Application.Union(Range("B9:B" & Range("B" & Rows.Count).End(xlUp).Row), Range("O9:O" & Range("O" & Rows.Count).End(xlUp).Row)).Select
    Selection.Copy

shSUIVI.Activate

    ActiveSheet.Paste
End With

MsgBox "MAJ Terminée", vbOKOnly
End Sub
Sub MaProcedure()

NomFichier = RechercheFichier()

If NomFichier = "" Then
MsgBox "Vous n'avez sélectionné aucun fichier"
Else
Workbooks.Open NomFichier

End If

NomFichier = ActiveWorkbook.Name
End Sub
Function RechercheFichier() As String

    Dim fd As FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
        .Filters.Add "fichier xlsm", "*.xlsm"
        .Title = "Recherche de fichier"
        'mettre le chemin du repertoire
        .InitialFileName = "C:\"
        'repertoire fichier
        Rep_Fichier = .InitialFileName
    End With

    If fd.Show = -1 Then NomFichier = fd.SelectedItems(1)

    If IsEmpty(fd.SelectedItems(1)) Then
    MsgBox "Vous n'avez sélectionné aucun fichier"
    NomFichier = Null
    Else
    NomFichier = fd.SelectedItems(1)
    End If

    RechercheFichier = NomFichier

End Function
Le 28/02/2016 à 21:18

Salut Tom et bienvenue sur le Forum,

La prochaine fois joins ton fichier, c’est toujours très utile.

Losque ta macro arrive sur la deuxième instruction indiquée en jaune ci-dessous, ta variable NomFichier est vide car tu as pensé de la charger dans un autre module, mais ça ne suit pas. Afin que la variable NomFichier que tu charges dans un autre module soit utilisable ici, tu dois placer quelque part l’instruction ‘’Public NomFichier’’, tel que tu le vois dans la première ligne jaune ci-dessous.

Je trouve ta manière d’ouvrir un deuxième fichier par l’intermédiaire d’une macro assez alambiquée.

Cordialement.

capture
Le 28/02/2016 à 21:21

Salut Tom,

je n'ai jamais travaillé avec ce genre d'instructions et sans fichier pour mettre les mains dans le cambouis...

Mais, en fouillant le Net, je suis tombé sur ceci :

Criteria1:="=Puissance"

Ne faut-il pas un signe = DANS tes guillemets ?

A+

Le 28/02/2016 à 21:54

Bonsoir Yvouille et curulis,

Yvouille :

Merci ta réponse a fait légèrement progressé ma macro, celle-ci non seulement ne passe pas à l'onglet choisi du classeur B et du coup aucune procédure de filtre ne se produit...

J'avais au départ constitué cette macro dans l'autre sens, c'est à dire que j'initialisait la macro dans le classeur B qui me filtrait puis copiait et en collait dans un nouveau classeur créé par la macro dès le départ. Celle-ci fonctionnait pas trop mal.

Mais depuis que j'essaye de la faire tourner dans ce sens je n'y comprends plus rien...

curulis :

Je ne pense que cela provienne des critères de filtre, mais plutôt de l'activation du classeur B sur le bon onglet.

Merci,

Le 28/02/2016 à 21:59
tom_44800 a écrit :

..... je n'y comprends plus rien...

Admettons que tu n'aies aucune macro à disposition : Fournis-nous tes deux fichiers et indique-nous ce que tu désires réaliser.

Amicalement.

Le 29/02/2016 à 08:47

Bonjour à tous,

Suivi test : Classeur A (où se situe la macro)

Classeur 1 : Classeur B (cible)

En espérant que cela aidera l'un d'entre vous à m’éclairer.

Merci par avance.

Le 29/02/2016 à 11:00

Bonjour,

Tout d'abord ton fichier Classeur1 comporte 391 styles de cellules différents

Essaie cette procédure :

Option Explicit
Option Private Module

Public Sub DEMO()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim fd As FileDialog
Dim Filename As String
Dim rng As Range, rng2 As Range
Dim lRow As Long
    '----------------------------------------------------------------------
    Application.ScreenUpdating = False
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Feuil1")
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Excel macros", "*.xlsm"
        .Title = "Recherche de fichier"
        .InitialView = msoFileDialogViewSmallIcons
        '.InitialFileName = wb.Path
        .AllowMultiSelect = False
    End With

    If fd.Show <> -1 Then
        MsgBox " Vous n'avez pas sélectionné de fichier.", _
               vbOKOnly + vbCritical
        GoTo exit_Handler
    Else
        Filename = fd.SelectedItems(1)
        Set wb2 = Workbooks.Open(Filename)
    End If
    '----------------------------------------------------------------------
    With wb2.Worksheets("Suivi")
        If .FilterMode Then .ShowAllData
        'Set rng = .Cells(9,2).CurrentRegion
        'ou
        Set rng = .Range("$B$9:$IB$9467")
        With rng
            .AutoFilter Field:=13, Criteria1:="SIGNE"
            .AutoFilter Field:=5, Criteria1:="Déployé"
            .AutoFilter Field:=112, Criteria1:="="
        End With
        Set rng = Nothing
        With .AutoFilter.Range
            On Error Resume Next
            Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                       .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
        If rng2 Is Nothing Then
            MsgBox "Il n'y pas pas de données à copier", vbOKOnly
        Else
            Set rng2 = Nothing
            Set rng = .AutoFilter.Range
            Debug.Print rng.Address
            lRow = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count
            Set rng2 = Union(rng.Columns(1).SpecialCells(xlCellTypeVisible), _
                            rng.Columns(14).SpecialCells(xlCellTypeVisible))
            rng2.Copy Destination:=ws.Cells(9, 2)
        End If
    End With
    'wb2.Close savechanges:=False
    '----------------------------------------------------------------------
    MsgBox "MAJ Terminée", vbOKOnly + vbInformation

    Set rng2 = Nothing: Set rng = Nothing
    Set wb2 = Nothing

exit_Handler:
    Set ws = Nothing
    Set wb = Nothing
    Exit Sub

End Sub
Le 29/02/2016 à 14:20

Bonjour Jean-Eric,

Merci beaucoup pour cette macro optimisée.

Cela fonctionne parfaitement.

Merci à tous pour votre aide.

Bien cordialement.

Rechercher des sujets similaires à "macro buguee"