Page Bilan - Il manque un import

Bonjour,

Sur mon fichier ci-joint j'ai une page synthèse qui fait très bien son taf à l'exception d'un point.

Normalement dans docuement à réprendre elle devrait si la case avis est R me sortir les documents indiqué R venant de son onglet visa.

Plus simplement dans mon exmple le visa 3 est en R, dans celui ci les deux documents R devrait ressortir noté (aaaa-bbbb) en ne prenant pas en compte zzzz qui est bon.

Je ne vois pas ou cela coince :/

Si quelqu'un pouvait me dépanner ce serait bien gentil :)

Bonjour Anthony,

Votre logique n'étant pas la notre, pouvez-vous nous expliquer comment cela fonctionne

Et quel module pose souci ?

@+

Bonjour,

Sur la page principale il y a une synthèse de l'ensemble des visas.

Sur cette page la colonne H (I-J) affiche les documents à reprendre.

Pour ce faire, elle doit regarder si la case d'à côté est R, AO ou AF. Si R, elle doit aller voir dans le visa en question et ressortir les documents qui ont un listing R.

Donc dans l'exemple aller dans VISA 3 et ressortir "aaaa - bbbb"

Le soucis doit venir de mon import, mais je n'ai trouvé ou

Est-ce un poil plus compréhensible ?

Re,

Désolé, mais j'ai du mal à comprendre le déroulé

Comment sont enregistrés les informations de la page "LISTE DES VISAS" ?

Quels boutons sont cliqués ou codes lancés dans l'ordre ?

@+

Il faut cliquer sur "synthèse des visas" qui active la macro "importationdesVisa"

C'est un import d'information de l'ensemble des page "Visa X"

Ok,

Donc si j'ai bien compris, voici le code à utiliser, qui remplace l'ancien

Sub ImportationDesVisa()
  Dim Ws As Worksheet
  Dim Obs As String
  Dim LigListe As Integer
  Dim dLigVisa As Long, LigVisa As Long

  Application.ScreenUpdating = False
  Application.EnableEvents = False

  With Worksheets("LISTE DES VISAS")
    .Activate
    .Range("A11:J1500").ClearContents
    LigListe = 1
    For Each Ws In ActiveWorkbook.Worksheets
      If Ws.Name Like "VISA*" Then
        dLigVisa = Ws.Range("B" & Rows.Count).End(xlUp).Row
        ' Pour chauqe ligne remplie
        For LigVisa = 13 To dLigVisa
          If Ws.Range("B" & LigVisa) = "" Then GoTo Suite_LigVisa
          ' Sinon
          .Cells(10 + LigListe, 1).Value = Ws.Cells(6, 9).Value
          .Cells(10 + LigListe, 2).Value = Ws.Cells(4, 9).Value
          .Cells(10 + LigListe, 3).Value = Ws.Cells(5, 9).Value
          .Cells(10 + LigListe, 6).Value = Ws.Cells(3, 10).Value
          .Cells(10 + LigListe, 7).Value = Ws.Cells(4, 10).Value
          ' Récuérer l'observaton
          Obs = Ws.Cells(LigVisa, "H").Value
          If Ws.Cells(LigVisa, "G").Value = "R" And Obs = "" Then
            Obs = "Aucun Document trouvé"
            .Cells(10 + LigListe, 8).Interior.Color = RGB(255, 204, 222)
            .Cells(10 + LigListe, 8).Value = Obs
          Else
            .Cells(10 + LigListe, 8).Value = Obs
            .Cells(10 + LigListe, 8).Interior.Color = RGB(255, 255, 255)
          End If
          .Cells(10 + LigListe, 10).Value = Ws.Cells(7, 9).Value
          LigListe = LigListe + 1
          Obs = ""
Suite_LigVisa:
        Next LigVisa
      End If
    Next Ws
  End With
  Application.EnableEvents = True
End Sub

A tester et nous dire

@+

Merci pour ce retour mais ça ne fonctionne pas du tout.

On doit avoir une seul ligne dans la synthèse par page et là le code prend toutes les lignes des autres pages.

En plus il ne met pas la liste des documents dans la bonne ligne de synthèse.

+ J'ai du mal expliquer mais la colone H en synthèse doit rapporter les éléments en colonne B de la page VISA quand l'avis général du Visa qui se trouve sur chaque page en J4 est R

Pour que ce soit plus claire j'ai annoté la version ci-jointe

Re,

Essayez ceci alors

Sub ImportationDesVisa()
  Dim Ws As Worksheet
  Dim Obs As String
  Dim NumV As Integer
  Dim dLigListe As Long, LigListe As Long
  Dim dLigVisa As Long, LigVisa As Long

  Application.ScreenUpdating = False
  Application.EnableEvents = False

  With Worksheets("LISTE DES VISAS")
    .Activate
    ' Première ligne vide de la liste des visas
    LigListe = 11
    ' Pour chaque feuille du classeur
    For Each Ws In ThisWorkbook.Worksheets
      If Left(Ws.Name, 4) <> "VISA" Then GoTo SuiteWs
      ' Sinon on inscrit les premières infos
      .Cells(LigListe, 1).Value = Ws.Cells(6, 9).Value
      .Cells(LigListe, 2).Value = Ws.Cells(4, 9).Value
      .Cells(LigListe, 3).Value = Ws.Cells(5, 9).Value
      .Cells(LigListe, 6).Value = Ws.Cells(3, 10).Value
      .Cells(LigListe, 7).Value = Ws.Cells(4, 10).Value
      ' Dernière ligne remplie de la feuille
      dLigVisa = Ws.Range("B" & Rows.Count).End(xlUp).Row
      Obs = ""
      ' Pour chaque ligne de la feuille VISA
      For LigVisa = 13 To dLigVisa
        ' Si avis correspond
        If Ws.Range("G" & LigVisa) = .Range("G" & LigListe) Then
          Obs = Obs & Ws.Range("B" & LigVisa) & "-"
        End If
      Next LigVisa
      If Obs = "" Then
        .Cells(LigListe, 8).Interior.Color = RGB(255, 204, 222)
        .Cells(LigListe, 8).Value = "Aucun Document trouvé"
      Else
        Obs = Left(Obs, Len(Obs) - 1)
        .Cells(LigListe, 8).Value = Obs
        .Cells(LigListe, 8).Interior.Color = RGB(255, 255, 255)
      End If
      .Cells(LigListe, 10).Value = Ws.Cells(7, 9).Value
      LigListe = LigListe + 1
SuiteWs:
    Next Ws
  End With
  ' Fin
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

@+

Presque parfait,

par contre la il m'a aussi importer les documents pour ceux ayant un avis AO et AF, il faudrait que ce soit que pour R.

Merci de me dire si l'explication est bancal xD

Re,

Truyen Anthony a écrit :

Presque parfait,

par contre la il m'a aussi importer les documents pour ceux ayant un avis AO et AF, il faudrait que ce soit que pour R.

Merci de me dire si l'explication est bancal xD

Oui c'est ça

Il faut remplacer

If Ws.Range("G" & LigVisa) = .Range("G" & LigListe) Then

Par

If Ws.Range("G" & LigVisa) = "R" Then

@+