HELP // Retraitement EXCEL Fermé

Question

Bonjour à tous,

J'ai un léger soucis pour retraiter une information provenant d'un logiciel. Il s'agit d'un grand-livre de comptes.

J'ai créé une un feuillet permettant de reprendre les informations de mon importation que je souhaite exploiter. Cependant, pour que mon feuillet contenant les formules puisse fonctionner, j'ai besoin de retraiter préalablement mon importation (Grand-livre de tiers).

J'aimerais utiliser une macro "Enregistrer une macro" pour pouvoir automatiser le procéder et gagner du temps mais je bloque à une étape, le retraitement des tiers.

L'importation se présente ainsi pour la colonne TIERS, elle est combinée avec les dates des mouvements :


Exemple : 

Colonne A

TIERS "TEST A"
DATE
DATE
DATE
DATE
(Ligne vide)
TIERS "TEST B"
DATE
DATE
DATE
....


J'aimerais une technique lol pour pouvoir avoir ce genre de résultat (je parviens à le faire manuellement mais aucun intérêt à perdre autant de temps dessus :/) : 

Colonne A                                      Colonne B
TIERS "TEST A"                             DATE
TIERS "TEST A"                             DATE
TIERS "TEST A"                             DATE
TIERS "TEST A"                             DATE
TIERS "TEST B"                             DATE
TIERS "TEST B"                             DATE
TIERS "TEST B"                             DATE

Configuration: Windows / Chrome 78.0.3904.70

Patrice33740 · Answer

Bonjour,

Par exemple :
Option Explicit
Sub Retraitement()
Dim f As Worksheet
Dim c As Range
Dim v As Variant
Dim t As String
Dim d As Long
Dim n As Long
  Set f = ThisWorkbook.Worksheets("Importation")   ' à adapter
  With f
    Set c = .Range("B1")
    d = .Cells(.Rows.Count, "A").End(xlUp).Row
    For n = 1 To d
      v = .Cells(n, "A").Value
      If TypeName(v) = "String" Then
        t = v
      ElseIf TypeName(v) = "Date" Then
        c.Value = t
        c.Offset(0, 1).Value = v
        Set c = c.Offset(1)
      End If
    Next n
    .Columns(1).Delete
  End With
End Sub