Proposition macro

Bonjour tout le monde,

Je sollicite votre aide, je ne sais absolument pas faire une macro, du coup je fais du copier coller sur des centaines de lignes, car je ne vois pas d'autres solution!

Je récupère un fichier avec une mise en forme inexploitable!

en PJ, le Fichier Excel

-sur l'onglet "GL" c'est le fichier que je reçois (pour info l'original fait des centaines de lignes)

-sur l'onglet "Fichier attendu", c'est celui que le copie colle.

J'ai impérativement besoin de cette mise en forme pour construire mon TCD, et y croiser d'autres données, (là par contre, je sais le faire).

Si quelqu'un peut m'aider cela via une macro, ce serait formidable, un gain de temps considérable!

En vous remerciant d'avance pour votre proposition.

Clé de Sol

Bonjour,

On a compris ce que tu voulais, maintenant,

Je ne suis pas certain, mais pour éviter du travail inutile, il est possible/probable que le fichier original soit préférable. (non retouché)

Préciser également si c'est toujours le même fichier ou si c'est à chaque fois un fichier différent placé à un endroit différent.

EDIT : Euh quand je dis non retouché, le moins possible, Juste le nécessaire pour éviter des problèmes de confidentialité.

A+

Salut CleDeSol, Galopin01,

comme le dit si bien Galopin, le résultat ne sera pérenne que si le fichier de base a TOUJOURS la même structure.
Sinon, prière d'envoyer les "modèles" différents connus pour adapter le code.

Un double-clic sur la feuille 'GL' démarre la macro. Résultats en ligne 20 de 'FICHIER ATTENDU' pour contrôle

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tData, iStep%, sClient$
'
Cancel = True
tTab = Range("A" & Columns(1).Find(what:="Date", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlNext).Row + 1 & _
    ":I" & Range("I" & Rows.Count).End(xlUp).Row).Value
tData = Range("AA1").Resize(UBound(tTab, 1), 9).Value
'
For x = 1 To UBound(tTab, 1)
    If tTab(x, 4) <> "" And tTab(x, 4) <> sClient Then
        sClient = tTab(x, 4)
        For y = x + 1 To UBound(tTab, 1)
            If tTab(y, 5) <> "" Then
                iStep = iStep + 1
                tData(iStep, 1) = tTab(x, 1)
                tData(iStep, 2) = sClient
                tData(iStep, 3) = tTab(y, 1)
                tData(iStep, 4) = tTab(y, 2)
                tData(iStep, 5) = tTab(y, 3)
                tData(iStep, 6) = tTab(y, 5)
                tData(iStep, 7) = tTab(y, 6)
                tData(iStep, 8) = tTab(y, 7)
                tData(iStep, 9) = tTab(y, 8)
            Else
                x = y - 1
                Exit For
            End If
        Next
    End If
Next
With Worksheets("FICHIER ATTENDU")
    .Range("A20").Resize(iStep, 9).Value = tData
    .Activate
End With
'
End Sub

A+

Bonjour Galopin,

merci pour ce retour,

je reçois ce fichier par mail toutes les semaines , c'est toujours le même, juste que le nom change car il y a une notion de date.

En pj, le fichier orignal, j'ai uniquement modifié le nom des clients.

A ta dispo, si besoin

Re,

pour le fun, pour améliorer le look..

With Worksheets("FICHIER ATTENDU")
    If .[A2] <> "" Then .Range("A2:I" & .Range("A" & Rows.Count).End(xlUp).Row).Clear
    .Range("A2").Resize(iStep, 9).Value = tData
    .Range("A1:I1").BorderAround LineStyle:=xlContinuous
    .Range("A2:B" & 1 + iStep).BorderAround LineStyle:=xlContinuous
    .Range("I2:I" & 1 + iStep).BorderAround LineStyle:=xlContinuous
    .Range("A1").CurrentRegion.BorderAround Weight:=xlMedium
    .Activate
End With

A+

Merci beaucoup Curulis 57.

je n'arrive pas à ouvrir le fichier Cledesol.....il y a une sécurité pour mon ordi

grrrrrrrrrrrrrrrrrrrrrr

CleDeSol,

va dans l'explorateur de fichier -> clic droit sur le fichier -> Propriétés -> Cochez "Débloquer" -> Valider.

Devrait aller...

yes yes :) merci

c'est magique

je n'ai pas compris ou mettre ton amélioration.....mais c'est déjà très bien.

je viens de tester avec la version originale, c'est par fait...encore MERCI

Tant mieux!
Le code est à coller dans le module VBA de la feuille 'GL'.
Le voici avec "l'amélioration" qui affiche le résultat directement en 'FICHIER ATTENDU' [A2].
À toi à le placer dans le bon module de ton fichier de travail réel et d'adapter, éventuellement, le nom de la feuille 'FICHIER ATTENDU'

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tData, iStep%, sClient$
'
Cancel = True
tTab = Range("A" & Columns(1).Find(what:="Date", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlNext).Row + 1 & _
    ":I" & Range("I" & Rows.Count).End(xlUp).Row).Value
tData = Range("AA1").Resize(UBound(tTab, 1), 9).Value
'
For x = 1 To UBound(tTab, 1)
    If tTab(x, 4) <> "" And tTab(x, 4) <> sClient Then
        sClient = tTab(x, 4)
        For y = x + 1 To UBound(tTab, 1)
            If tTab(y, 5) <> "" Then
                iStep = iStep + 1
                tData(iStep, 1) = tTab(x, 1)
                tData(iStep, 2) = sClient
                tData(iStep, 3) = tTab(y, 1)
                tData(iStep, 4) = tTab(y, 2)
                tData(iStep, 5) = tTab(y, 3)
                tData(iStep, 6) = tTab(y, 5)
                tData(iStep, 7) = tTab(y, 6)
                tData(iStep, 8) = tTab(y, 7)
                tData(iStep, 9) = tTab(y, 8)
            Else
                x = y - 1
                Exit For
            End If
        Next
    End If
Next
With Worksheets("FICHIER ATTENDU")
    If .[A2] <> "" Then .Range("A2:I" & .Range("A" & Rows.Count).End(xlUp).Row).Clear
    .Range("A2").Resize(iStep, 9).Value = tData
    .Range("A1:I1").BorderAround LineStyle:=xlContinuous
    .Range("A2:B" & 1 + iStep).BorderAround LineStyle:=xlContinuous
    .Range("I2:I" & 1 + iStep).BorderAround LineStyle:=xlContinuous
    .Range("A1").CurrentRegion.BorderAround Weight:=xlMedium
    .Activate
End With
'
End Sub

Bon travail! Courage!
A+

EXCELLENT

Encore merci

:) :)