transferer une colonne dans colonne précédente

[zesuila]

Bonjour (il y avait longtemps que je n'étais pas passé par ici )
j'ai besoin d'une macro me permettant de transférer les cellules remplies de la colonne b juste derrière la dernière cellule remplie de la colonne A. C'est possible ?
merci de votre aide

 

[belkacem_64]

bonjour
voila le code

Private Sub CommandButton1_Click()

Range("B" & Range("A" & Rows.Count).End(xlUp).Row & ":B" & Range("B" & Rows.Count).End(xlUp).Row).Copy
Range("D1").PasteSpecial xlPasteValues
Application.CutCopyMode = False

End Sub

 

[zesuila]

Bonjour Belkacem_64
Merci de ta réponse.
Le code n'a pas l'air de fonctionner, rien ne se passe.
Si j'ai bien compris le code sélectionne les cellules de la colonne A puis de la colonne B et les copie à partir de la cellule D1
mais là rien ne se fait !

 

[belkacem_64]

Bonjour
voila le fichier comme exemple

 

[zesuila]

Bonjour
Je dois être une quiche, mais lorsque je clique sur le fichier joint, on me demande d'utiliser le converter mais rien ne se passe là non plus (j'ai excel 2003).
j'ai aussi simplifié mon fichier et lorsque j'execute le code, il ne me copie e D1 que les deux dernières adresses de la colonne B

 

[Yurperqod]

Bonjour le forum

Tel que j'ai compris le problème décris, voici deux macros

Sub Macro1()
'Macro à utiliser si données texte en colonne B
Columns("B:B").SpecialCells(xlCellTypeConstants, 2).Copy
Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True
End Sub
Sub Macro2()
'Macro à utiliser si données numériques en colonne B
Columns("B:B").SpecialCells(xlCellTypeConstants, 1).Copy
Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True
End Sub

 

[Yurperqod]

Une dernière macro qui prend en compte les cellules non vides de la colonne B
(sans distinguer le type de données)
et qui copie dans la première cellule vide de la colonne A puis supprime les colonnes B et C.

Sub Macro3()
Dim DerLigne As Long
DerLigne = Cells(Rows.Count, 2).End(xlUp).Row
Range(Cells(1, 3), Cells(DerLigne, 3)).FormulaR1C1 = "=IF(RC[-1]<>"""",""X"",0)"
Columns("C:C").SpecialCells(xlCellTypeFormulas, 2).Offset(, -1).Copy
Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteAll, SkipBlanks:=True
Application.CutCopyMode = False
Columns("B:C").Delete
End Sub

 

[zesuila]

Bonjour le forum

Tel que j'ai compris le problème décris, voici deux macros

Sub Macro1()
'Macro à utiliser si données texte en colonne B
Columns("B:B").SpecialCells(xlCellTypeConstants, 2).Copy
Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True
End Sub
Sub Macro2()
'Macro à utiliser si données numériques en colonne B
Columns("B:B").SpecialCells(xlCellTypeConstants, 1).Copy
Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True
End Sub

Bonjour Yurperqod
La 1ere macro est la bonne (je n'ai pas essayé la 2e -ce n'est pas du numérique ni la 3e)
Par contre pour simplifier ma demande je n'avais donné que 2 colonnes. En fait
j'ai 3 colonnes avec des emails et une 4e avec une info concernant ces emails.
Le principe est le même copier donc les colonnes b c à la suite de la colonne A. mais en gardant pour chaque ligne l'info de la colonne D
peux tu me rectifier ton code pour cela ou n'est ce pas possible ?
encore merci

 

[zesuila]

Je ne sais pas si j'ai le droit à un petit up pour m'aider à finaliser mon projet

 

[Yurperqod]

Bonjour le forum

Un classeur exemple avec plus de détails et le résultat à obtenir mis "à la main" sur un autre onglet serait un plus.

 

[zesuila]

Bonjour Yurperqod
Voici un fichier exemple avec le résultat escompté.
Merci de ton aide

 

[Yurperqod]

Bonjour le forum

A essayer.

Sub Macro2()
Dim ligne As Long, Compteur As Long
ligne = Cells(Rows.Count, 1).End(xlUp).Row
For ligne = 2 To ligne
Cells(ligne, 1).Resize(, 3).Copy
Compteur = Cells(Rows.Count, "F").End(xlUp).Row + 1
Cells(Rows.Count, "F").End(xlUp).Offset(1).PasteSpecial Paste:=xlValues, SkipBlanks:=True, Transpose:=True
Cells(Compteur, "G") = Cells(ligne, 4)
Compteur = Compteur + 1
Next
With Range(Cells(2, "G"), Cells(Compteur - 1, "G"))
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
Range("G2").CurrentRegion.Cut Cells(ligne + 2, 1)
End Sub

 

[zesuila]

Bonjour Yurperqod
Super ! Cela fonctionne
Merci beaucoup

 

[zesuila]

Bonjour Yurperqod et les autres
J'ai tenté de modifier le code de Yuperqod pour que sa macro fonctionne non plus avec 3 colonnes avec des emails et une 4e avec une info concernant ces emails, mais avec 5 colonnes avec des emails et une 6e avec les infos concernant ces emails. Mais je n'y arrive pas ! un petit coup de main pour finaliser mon projet.
Merci beaucoup

 

[zesuila]

Bon alors j'ai essayé d'y arriver tout seul ! c'est presque ça ! j'ai juste un problème.
La macro transfère bien les colonnes b c d e et f un peu plus bas dans la colonne A mais la derniere ligne n'est pas complètement copiée. Je n'ai que la colonne A et F de copié pas B c D et E
tableau origine derniere ligne :
colA - ol
col B - ol2
col C - ol3
col D - ol4
col E - ol 5
col f - info
Résultat après ma macro dernière ligne :
col A -ol
col b, c , d , e = rien
col F : info

voici mon code :
Sub Macro2()
Dim ligne As Long, Compteur As Long
ligne = Cells(Rows.Count, 1).End(xlUp).Row
For ligne = 2 To ligne
Cells(ligne, 1).Resize(, 5).Copy
Compteur = Cells(Rows.Count, "H").End(xlUp).Row + 1
Cells(Rows.Count, "H").End(xlUp).Offset(1).PasteSpecial Paste:=xlValues, SkipBlanks:=True, Transpose:=True
Cells(Compteur, "I") = Cells(ligne, 6)
Compteur = Compteur + 1
Next
With Range(Cells(2, "I"), Cells(Compteur - 1, "I"))
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
Range("I2").CurrentRegion.Cut Cells(ligne + 3, 1)
End Sub

j'espère avoir été asez précis !
merci