Création d'un tableau en décalage.

[JJ1]

Bonjour,

Je voudrais décaler automatiquement des données situées à partir de B600 en fonction de la valeur en colonne A (en forme d'escalier montant ) et en laissant une colonne vide entre les valeurs.
Certaines données peuvent être vides (ex 4bis)
Je joins un exemple commençant en B20.
Ce serait bien en VBA car le tableau est très chargé en MFC.
Merci de votre astuce.

Bon samedi à tous.

 

[Efgé]

Re : Création d'un tableau en décalage.

Bonjour JJ1,
Comme il y a un "4bis", je ne vois qu'une solution :

Sub test()
Dim i&, Dest As Range
With Sheets("Feuil2")
    For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
        Select Case .Cells(i, 1).Value
            Case 1
                Set Dest = .Cells(i, 8)
            Case 2
                Set Dest = .Cells(i, 14)
            Case 3
                Set Dest = .Cells(i, 20)
            Case "4bis"
                Set Dest = .Cells(i, 26)
            Case 4
                Set Dest = .Cells(i, 32)
            Case 5
                Set Dest = .Cells(i, 38)
        End Select
        If Not Dest Is Nothing Then
            With .Range(.Cells(i, 2), .Cells(i, 6))
                .Copy Dest
                .ClearContents
            End With
        End If
        Set Dest = Nothing
    Next i
End With
End Sub

Mais attendons d'autres idées
Cordialement

 

[JJ1]

Re : Création d'un tableau en décalage.

Bonjour Efgé,

Merci pour ton code efficace qui a fonctionné super.

Bon samedi.

 

[jp14]

Re : Création d'un tableau en décalage.

Bonjour
Bonjour Efgé

Comme je l'ai écris voici un autre code.

Sub travdem()
Dim Nomfeuille1 As String, Col1 As String
Dim MonTab As Variant, Compt1 As Long, I As Long, Coln As Long, Col1n As Long
Dim NbChiffre As Byte, J As Byte
Dim valeur1 As String
Dim dl1 As Long
'parametre
Nomfeuille1 = "Feuil2"
Col1 = "A"

NbChiffre = 5
Coln = NbChiffre + 3
'code
With Sheets(Nomfeuille1)
dl1 = .Range(Col1 & .Rows.Count).End(xlUp).Row
valeur1 = CStr(.Range(Col1 & dl1))

For I = dl1 To 1 Step -1
If valeur1 = CStr(.Range(Col1 & I)) Then Coln = NbChiffre + 3
If .Range(Col1 & I) <> "" Then
    For J = 1 To NbChiffre
        If .Cells(I, J + 1) <> "" Then
            .Cells(I, Coln) = .Cells(I, J + 1)
            Coln = Coln + 1

        End If
    Next J
        If .Cells(I, 2) = "" Then Coln = Coln + NbChiffre
        Coln = Coln + 1
    Else

End If

Next I

End With
End Sub

A tester

JP