Eclater une ligne sur plusieurs ligne
Bonjour à tous,
Je bidouille depuis quelques années sur excel, et cherche avec plaisir à élucider mes petits casse-tête, mais là...
Il me semble qu'il est nécessaire de passer par VBA
Et le problème est que je ne sais pas utiliser VBA...
Voici ce que je voudrai faire:
En partant de cette Feuil1
Copier rang (A2;F2), Coller en Feuil2 rang (A2;F2)
passer à la ligne
Copier Cell G2, Coller en Feuil2 Cell A3
Copier Cell H2, Coller en Feuil2 Cell C3
Copier rang (I2;L2), Coller en Feuil2 rang (G3;J3)
if K2= "FOR_ARR_*" then passer à la ligne et coller K2 en feuil2 A4
Else
if M2 <>"" then Coller à la ligne en colonne A
Else
If N2<>"" then Coller à la ligne en colonne A
Else
If O2<>"" then Coller à la ligne en colonne A
Arrivé en colonne P, sauter une ligne et recommencer en feuil1 ligne 3
Pour en arriver à:
Feuil2
Je ne suis pas sûr d'être clair, je ne sais pas si c'est réalisable, je ne sais pas si c'est compliqué...mais j'espère qu'un amateur de casse-tête pourra m'aider.
Merci d'avance pour vos retours.
Salut SoGro,
pas un casse-tête... mais vérifie quand même : je suis parfois si distrait!
Un double-clic en 'BDD' démarre la macro...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim iRow%
'
Cancel = True
Application.ScreenUpdating = False
'
With Worksheets("EXTRACT")
.Cells.Delete
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
iRow = iRow + IIf(iRow = 0, 1, 2)
.Range("A" & iRow & ":F" & iRow).Value = Range("A" & x & ":F" & x).Value
iRow = iRow + 1
.Cells(iRow, 1) = Cells(x, 7)
.Cells(iRow, 3) = Cells(x, 8)
.Range("G" & iRow & ":J" & iRow).Value = Range("I" & x & ":L" & x).Value
If Cells(x, 11) = "FOR_ARR_*" Then
iRow = iRow + 1
.Cells(iRow, 1) = Cells(x, 11)
End If
For y = 1 To 3
If Cells(x, 12 + y) <> "" Then
iRow = iRow + 1
.Cells(iRow, 1) = Cells(x, 12 + y)
End If
Next
Next
.Activate
End With
'
Application.ScreenUpdating = True
'
End Sub
A+
Bonjour Curulis,
Merci pour ta réponse, et ta solution qui fonctionne à merveille!
J'essaierai de trouver quelque chose de plus complexe pour la prochaine fois!
Je suis ravi de voir que j'ai compris certaines choses dans ce code, et j'y ai apporté quelques modifications
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim iRow%
'
Cancel = True
Application.ScreenUpdating = False
'
With Worksheets("EXTRACT")
.Cells.Delete
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
iRow = iRow + IIf(iRow = 0, 1, 2)
.Range("A" & iRow & ":F" & iRow).Value = Range("A" & x & ":F" & x).Value
iRow = iRow + 1
.Cells(iRow, 1) = Cells(x, 7)
.Cells(iRow, 3) = Cells(x, 8)
.Range("G" & iRow & ":H" & iRow).Value = Range("I" & x & ":J" & x).Value
.Cells(iRow, 10) = Cells(x, 12)
If Cells(x, 11) = "FOR_ARR_STR" Or Cells(x, 11) = "FOR_ARR_PVC" Then
iRow = iRow + 1
.Cells(iRow, 1) = Cells(x, 11)
.Cells(iRow, 9).Value = "H"
.Cells(iRow, 3) = Cells(x, 8)
Else: .Cells(iRow, 9) = Cells(x, 11)
End If
For y = 1 To 3
If Cells(x, 12 + y) <> "" Then
iRow = iRow + 1
.Cells(iRow, 1) = Cells(x, 12 + y)
End If
Next
Next
.Activate
End With
'
Application.ScreenUpdating = True
'
End Sub
Bon... de là a écrire la macro tout seul...mais c'est un premier pas qui donne envie de faire le second!
Encore un grand merci!