Mise a jour 4 feuilles sur 1 feuille

roby

XLDnaute Occasionnel
Bonjour,

Je bloque sur une mise a jour de 4feuilles extraites sur une feuille récapitulative.

j'aimerai que sur la feuille "Tableau PSAP" feuille récapitulative
suivant les n° correspondants en colonne A il soit copier la date "DATEL" de la feuille "Extractions 1" puis "Extractions2" puis "Extractions 3" etc...

Précisions:
si le N° existe -> modification de la date en colonne "I" et modification aussi en colonne "K" en mettant par exemple "Extraction 1" si la mise à jour est faite avec la feuille "Extractions 1" et ainsi de suite.

Si le N° n'existe pas -> créer la ligne en fin de tableau en ajoutant ici pour l'exemple, le N°, la date et le type "Extractions 1" ou "Extraction 2" etc....

je vous remercie d'avance

bonne fin de journée
 

Pièces jointes

  • Tableau suivi ROBY.zip
    139.7 KB · Affichages: 67

Papou-net

XLDnaute Barbatruc
Re : Mise a jour 4 feuilles sur 1 feuille

Bonsoir roby,

Si j'ai bien appréhendé la question, ta macro modifiée comme suit devrait répondre à ton attente :

Code:
Private Sub CommandButton3_Click()
'Bouton Test
Dim DL1, DL2, LIG1 As Long, Ligne As Long
Dim NumEcrou As Object
Application.ScreenUpdating = False

'Verification n° Ecrou
For Each sh In ThisWorkbook.Sheets
  If InStr(sh.Name, "Extractions") > 0 Then
    With sh
      DL1 = .Range("A65536").End(xlUp).Row
      For LIG1 = 2 To DL1
        VPremier = .Cells(LIG1, 1)
        Set NumEcrou = Sheets("Tableau PSAP").Range("A:A").Find(VPremier, LookIn:=xlValues, lookat:=xlWhole)
        If Not NumEcrou Is Nothing Then
          Ligne = NumEcrou.Row
          Else
          Ligne = Sheets("Tableau PSAP").Range("A65536").End(xlUp).Row + 1
        End If
        Sheets("Tableau PSAP").Range("A" & Ligne) = .Range("A" & LIG1)
        Sheets("Tableau PSAP").Range("I" & Ligne) = .Range("B" & LIG1)
      Next
    End With
  End If
Next
Application.ScreenUpdating = True
End Sub


Il reste que je n'ai pas compris comment remplir la colonne K de la feuille "TABLEAU PSAP".

Espérant avoir répondu.

Cordialement.
 
Dernière édition:

roby

XLDnaute Occasionnel
Re : Mise a jour 4 feuilles sur 1 feuille

Bonjour le forum , Papou-net

en colonne K je mets ce que a quoi correspond l'extraction 1, 2, 3, 4.
c'est a dire dans le tableau PSAP
extractions 1 = Primaire hors SSJ
extractions 2 = Primaire ac SSJ
extractions 3 = Récidivistes hors SSJ
extractions 4 = Récidivistes ac SSJ

sinon a première vu ton code fonctionne je te remercie

@+
 

Papou-net

XLDnaute Barbatruc
Re : Mise a jour 4 feuilles sur 1 feuille

Bonjour le forum , Papou-net

en colonne K je mets ce que a quoi correspond l'extraction 1, 2, 3, 4.
c'est a dire dans le tableau PSAP
extractions 1 = Primaire hors SSJ
extractions 2 = Primaire ac SSJ
extractions 3 = Récidivistes hors SSJ
extractions 4 = Récidivistes ac SSJ

sinon a première vu ton code fonctionne je te remercie

@+

Bonsoir roby,

Il suffit alors d'ajouter 2 lignes pour compléter ta macro :

Code:
Private Sub CommandButton3_Click()
'Bouton Test
Dim DL1, DL2, LIG1 As Long, Ligne As Long
Dim NumEcrou As Object
Extr = Array("", "Primaire hors SSJ", "Primaire ac SSJ ", "Récidivistes hors SSJ", "Récidivistes ac SSJ", "") '<--- Ligne ajoutée
Application.ScreenUpdating = False

'Verification n° Ecrou
For Each sh In ThisWorkbook.Sheets
  If InStr(sh.Name, "Extractions") > 0 Then
    With sh
      DL1 = .Range("A65536").End(xlUp).Row
      For LIG1 = 2 To DL1
        VPremier = .Cells(LIG1, 1)
        Set NumEcrou = Sheets("Tableau PSAP").Range("A:A").Find(VPremier, LookIn:=xlValues, lookat:=xlWhole)
        If Not NumEcrou Is Nothing Then
          Ligne = NumEcrou.Row
          Else
          Ligne = Sheets("Tableau PSAP").Range("A65536").End(xlUp).Row + 1
        End If
        Sheets("Tableau PSAP").Range("A" & Ligne) = .Range("A" & LIG1)
        Sheets("Tableau PSAP").Range("I" & Ligne) = .Range("B" & LIG1)
        Sheets("Tableau PSAP").Range("K" & Ligne) = Extr(Right(sh.Name, 1)) '<--- Ligne ajoutée
      Next
    End With
  End If
Next
Application.ScreenUpdating = True
End Sub

Cordialement.
 
Dernière édition:

Discussions similaires

Réponses
5
Affichages
186

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 182
dernier inscrit
moutassim.amine