aide macro

Question

Bonjour, 

Je me permets de vous contacter pour vous demander votre aide sur un fichier que je dois travailler tous les mois ligne par ligne.
En effet, tous les mois, je fais une extraction d'un logiciel (dont je vous joints un exemple  du fichier = fichier brut )que je modifie à la main et qui me prend beaucoup de temps afin d'obtenir le fichier modifié.
 J'aimerais pouvoir obtenir, à l'aide d'un bouton par exemple, la présentation du fichier modifié directement afin de pouvoir gagné du temps.

https://www.cjoint.com/c/IIdtG03wjpp

Pour aider dans l'analyse, je souhaiterais aussi que dans la colonne A lorsque la case est vide qu'il me reprenne l’entête de l 'info qu'il y a en S7 ,S14, S44....(sur le tableau de l'onglet fichier Brut)

Merci encore pour votre aide



Configuration: Windows / Chrome 76.0.3809.132

Frenchie83 · Answer

Bonjour,

Ceci:
https://mon-partage.fr/f/ftiTdIcR/

le code

Sub Transfert()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, Lig_f2 As Long
    Dim Ville As String
    
    Application.ScreenUpdating = False
    Set f1 = Sheets("fichier brut")
    Set f2 = Sheets("fichier modifié")
    f2.Range(f2.Cells(7, "A"), f2.Cells(1000, "AA")).ClearContents
    DerLig_f1 = f1.[A10000].End(xlUp).Row
    Lig_f2 = 7
    For i = 7 To DerLig_f1
        If Cells(i, "S").Font.ColorIndex = 3 Then
            Ville = Cells(i, "S")
            i = i + 4
            Do While f1.Cells(i, "S").Font.ColorIndex <> 3
                If Cells(i, "C") <> "" And Cells(i, "C").Font.ColorIndex = 1 Then
                    f2.Cells(Lig_f2, "A") = Ville
                    f1.Range(Cells(i, "C"), Cells(i, "AA")).Copy Destination:=f2.Cells(Lig_f2, "C")
                    Lig_f2 = Lig_f2 + 1
                End If
                i = i + 1
                If i > DerLig_f1 Then Exit Sub
            Loop
        End If
        i = i - 1
    Next i
End Sub

Cdlt

Frenchie83 · Answer

Bonjour, Est ce que vous pensez que cela peut être du au fait que la donnée à transférer n'est pas une Ville Non, c'est parce que je me suis basé à la couleur rouge de la ville et qui n'existe pas dans le fichier réel. Voici la correction Sub Transfert() Dim f1 As Worksheet, f2 As Worksheet Dim DerLig_f1 As Long, Lig_f2 As Long Dim Ville As String Application.ScreenUpdating = False Set f1 = Sheets("fichier brut") Set f2 = Sheets("fichier modifié") f2.Range(f2.Cells(7, "A"), f2.Cells(1000, "AA")).ClearContents DerLig_f1 = f1.[A10000].End(xlUp).Row Lig_f2 = 7 For i = 7 To DerLig_f1 i = i - 1 If f1.Cells(i, "A") = "Entité" Then Ville = f1.Cells(i + 1, "S") i = i + 5 Do While f1.Cells(i, "A") <> "Entité" If f1.Cells(i, "C") <> "" And f1.Cells(i, "C").Font.ColorIndex = 1 Then f2.Cells(Lig_f2, "A") = Ville f1.Range(f1.Cells(i, "C"), f1.Cells(i, "AA")).Copy Destination:=f2.Cells(Lig_f2, "C") Lig_f2 = Lig_f2 + 1 End If i = i + 1 If i > DerLig_f1 Then Exit Sub Loop End If Next i End Sub le fichier https://mon-partage.fr/f/or3mME9O/ Cdlt

Aide macro

2 réponses

Discussions similaires

Newsletters