Créer un tableau par VBA selon certaines conditions

Résolu
Dreampower75 Messages postés 91 Statut Membre -  
Dreampower75 Messages postés 91 Statut Membre -
Bonjour,

Est-ce que cela est possible de créer un tableau, par 1 programmation VBA, dans l'onglet DTR du fichier Tableau Final ok selon certaines conditions ?

1. le tableau de l'onglet "DTR" du fichier "Tableau Final ok" respecte le modèle de l'onglet modèle
2. Les informations du fichier "2200RISK_charg" doivent être intégré dans l'onglet DTR selon le modèle du tableau de l'onglet "Modèle" (pour les colonnes B,C et G Uniquement)
3. Les éléments de la colonne B se terminant par "RISK" du tableau du fichier "2200RISK_charg" doivent être placés en partie haute du tableau avec les informations correspondantes en colonne C et en colonne G
4. Les éléments de la colonne B se terminant par "OPPOR" du tableau du fichier "2200RISK_charg" doivent être placés en partie basse du tableau avec les informations correspondantes en colonne C et en colonne G
5. La programmation VBA intègre le fait que les informations du fichier "2200RISK_charg" peuvent être plus ou moins nombreuses (voir capture d'écran ci-dessous): il peut y avoir 6 OU 5 etc... lignes concernés par les RISK (contre 3 lignes dans mon exemple) + il peut y avoir 6 ou 5 etc... lignes concernés par les OPPOR (contre 3 lignes dans mon exemple)

Merci beaucoup pour votre aide.

J'ai joint les fichiers concernés
Le lien a été crée (Fichier 2200RISK_charg) : https://www.cjoint.com/c/LDwiD0l22PO
Le lien a été crée (Fichier Tableau Final ok) : https://www.cjoint.com/c/LDwiEVVwaAO

RESULTAT FINAL SOUHAITE


CAPTURE D'ECRAN DES FICHIERS JOINTS
fichier "2200RISK_charg"


fichier "Tableau Final ok" => Onglet Modele

fichier "Tableau Final ok" => Onglet DTR


Les informations du fichier "2200RISK_charg" peuvent être plus ou moins nombreuses en terme de nombre de lignes:


Configuration: Windows / Chrome 100.0.4896.127

4 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    fichier "2200RISK_charg" doivent être intégré dans l'onglet DTR
    Ajoutees a celles qui sont deja dans DTR ou a la Place des ces infos?

    Les formules Somme doivent-elles etre mise a jour?
    1
    1. Dreampower75 Messages postés 91 Statut Membre 2
       
      J'ai essayé avec le codage ci-après mais cela ne fonctionne pas vraiment :

      Option Explicit

      Sub Extraire()
      Dim Titre, dt As Integer, ws As Worksheet, cel As Range, n As Integer
      Set ws = ThisWorkbook.Worksheets("DTR")


      With Sheets("coûts")
      For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)

      If cel.Offset(, 1) like "*RISK*" Then
      dt = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

      ws.Range("A" & dt) = cel.Offset(, 1)
      ws.Range("B" & dt) = cel.Offset(, 2)
      ws.Range("I" & dt) = cel.Offset(, 6)
      End If

      Next cel
      End With

      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      With Sheets("coûts")
      For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)

      If cel.Offset(, 1) like "*OPPOR*" Then
      dt = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

      ws.Range("A" & dt) = cel.Offset(, 1)
      ws.Range("B" & dt) = cel.Offset(, 2)
      ws.Range("I" & dt) = cel.Offset(, 6)
      End If

      Next cel
      End With
      0
  2. Dreampower75 Messages postés 91 Statut Membre 2
     
    Bonjour,

    Merci Forum : j'ai obtenu la solution qui est le codage ci-après



    For Each x In Workbooks
    If x.Name Like "*RISK.*" Then
    Application.Windows(x.Name).Activate: Exit For
    End If
    Next x

    With Sheets("Coûts")
    For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    '''''''''''''''''''''''''' RISK '''''''''''''
    If cel.Offset(, 1) Like "*RISK*" Then
    dt = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

    ws.Range("A" & dt) = cel.Offset(, 1)
    ws.Range("B" & dt) = cel.Offset(, 2)
    ws.Range("D" & dt) = cel.Offset(, 6) / 1000

    ws.Range("F" & dt).Formula = ws.Range("D" & dt).Formula
    ws.Range("I" & dt).Formula = ws.Range("D" & dt).Formula
    ws.Range("G" & dt).Formula = ws.Range("D" & dt).Formula
    ws.Range("J" & dt).Formula = ws.Range("D" & dt).Formula

    End If

    Next cel

    End With
    With ws
    .Range("A" & dt + 1) = "Total RISK"
    .Range("D" & dt + 1).Formula = "=sum(D8:D" & dt & ")"
    .Range("F" & dt + 1).Formula = "=sum(F8:F" & dt & ")"
    .Range("G" & dt + 1).Formula = "=sum(G8:G" & dt & ")"
    .Range("J" & dt + 1).Formula = "=sum(J8:J" & dt & ")"
    .Range("K" & dt + 1).Formula = "=sum(J8:J" & dt & ") - sum(G8:G" & dt & ")"
    .Range("I" & dt + 1).Formula = ThisWorkbook.Sheets("Détail des risques").Range("I1").Formula
    End With

    ''''''''' RAJOUT "A JUSTIFIER CDP"
    ''''''''' RAJOUT "A JUSTIFIER CDP"

    With ws
    dt = dt + 2
    .Range("K" & dt).Formula = ThisWorkbook.Sheets("Détail des risques").Range("K1").Formula

    End With
    ''''''''' RAJOUT "A JUSTIFIER CDP"
    ''''''''' RAJOUT "A JUSTIFIER CDP"

    dt = dt + 4 '+4 à ajuster selon le nombre de lignes à insérer
    Deb = dt 'sauvegarde de la première ligne pour les OPPORT

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''''''PARTIE OPPOR OPPOR OPPOR
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    For Each x In Workbooks
    If x.Name Like "*RISK.*" Then
    Application.Windows(x.Name).Activate: Exit For
    End If
    Next x

    With Sheets("Coûts")
    For Each cel In .Range("A11:A" & .Range("A" & Rows.Count).End(xlUp).Row)
    '''''''''''''''''''''''''' OPPOR '''''''''''''
    If cel.Offset(, 1) Like "*OPPOR*" Then

    ws.Range("A" & dt) = cel.Offset(, 1)
    ws.Range("B" & dt) = cel.Offset(, 2)
    ws.Range("D" & dt) = cel.Offset(, 6) / 1000

    ws.Range("F" & dt).Formula = ws.Range("D" & dt).Formula
    ws.Range("I" & dt).Formula = ws.Range("D" & dt).Formula
    ws.Range("G" & dt).Formula = ws.Range("D" & dt).Formula
    ws.Range("J" & dt).Formula = ws.Range("D" & dt).Formula
    dt = dt + 1
    End If

    Next cel
    End With
    With ws
    .Range("A" & dt) = "Total OPPOR"
    '''''''''''''''''''''' Il faut diviser par 2
    .Range("D" & dt).Formula = "=sum(D" & Deb & ":D" & dt & ") /2"
    .Range("F" & dt).Formula = "=sum(F" & Deb & ":F" & dt & ") /2"
    .Range("G" & dt).Formula = "=sum(G" & Deb & ":G" & dt & ") /2"
    .Range("J" & dt).Formula = "=sum(J" & Deb & ":J" & dt & ") /2"
    .Range("K" & dt).Formula = "=sum(G" & Deb & ":G" & dt & ") /2 - sum(J" & Deb & ":J" & dt & ") /2"
    .Range("I" & dt).Formula = ThisWorkbook.Sheets("Détail des risques").Range("I2").Formula
    End With
    1
  3. Dreampower75 Messages postés 91 Statut Membre 2
     
    Bonjour,

    Ajouter à la place des infos du tableau de l'onglet DTR
    Les formules Somme doivent être mise à jour.

    Merci
    0
  4. Dreampower75 Messages postés 91 Statut Membre 2
     
    Bonjour,

    Ajouter à la place des infos du tableau de l'onglet DTR
    Les formules Somme doivent être mise à jour.

    Merci
    0