XL 2019 Besoin d'aide pour créer une boucle sur colonnes

[ddeval81]

Bonjour à tous,

Si vous pouviez m'aidez à optimiser ce code car je n'arrive pas à faire une boucle pour les colonnes et donc je refais le code manuellement à chaque fois 🙁


Sub column()
Dim i As Long
Dim cell As Range
Dim ligne As Integer
Dim ligne2 As Integer
ligne = 1
ligne2 = -1


For Each cell In Range("B:B")
If cell.Value = "X" Then
ligne = ligne + 1
cell.Offset(0, ligne2).Copy Worksheets("Sheet1").Range("D1").Offset(ligne, 1)
Range("B1").Copy Worksheets("Sheet1").Range("A1").Offset(ligne, 1)
'
End If
Next cell

ligne2 = ligne2 - 1
For Each cell In Range("C:C")
If cell.Value = "X" Then
ligne = ligne + 1
cell.Offset(0, ligne2).Copy Worksheets("Sheet1").Range("D1").Offset(ligne, 1)
Range("B1").Copy Worksheets("Sheet1").Range("A1").Offset(ligne, 1)
'
End If
Next cell

c'est donc les lignes :
For Each cell In Range("B:B")
For Each cell In Range("C:C")... que je veux mettre en boucle car j'ai plus de 30 colonnes...
Merci d'avance.


End Sub

 

[vgendron]

Bonjour

1) besoin d'un fichier exemple
2) que doit faire le code?

 

[ddeval81]

Ok merci bien 🙂
Le code doit copier la cellule de la colonne A qui lui correspond s'il y a un X et l'entête de la colonne par exemple si C6 a une croix il copiera la cellule C1.
Je joins le fichier je pense que ça sera plus clair...
L'idée est de transcrire ces données pour construction d'une base de donnée.

 

[vgendron]

en PJ une proposition==> Cliquer sur le bouton
j'ai mis des commentaires dans le code

 

[ddeval81]

Merci 1000 fois pour le fichier.
Honnêtement je ne suis pas encore capable d'écrire un code comme ça.
Mais je vais le reprendre et le décortiquer.
En tout cas c'est vraiment sympa de ta part!!