Visual Basic déplacer toutes les autres colonnes pour créer une longue colonne B
-
27-10-2019 - |
Question
J'ai une série de colonnes de données, chaque profondeur de 15 lignes. La colonne B est la colonne que je veux déplacer toutes les autres colonnes sous dans l'ordre. Ainsi, le contenu de la colonne C est coupé et déplacé en dessous déjà en B et ainsi de suite.
Jusqu'à présent je;
'Select a column
ActiveSheet.Range("B1", ActiveSheet.Range("B1").End(xlDown)).Select
'Cut
Selection.Cut
'Select cell at bottom of A
ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
'Paste
ActiveSheet.Paste
J'ai besoin de la boucle pour le faire fonctionner, en boucle à travers toutes les colonnes de A à FN.
Merci à l'avance.
La solution
Dim col As Range
For Each col In Worksheets("Sheet1").Columns
If (col.Column > 1 And col.Column < 171) Then
Range(col.Rows(1), col.Rows(15)).Select
Selection.Cut
'Select cell at bottom of A
ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste 'Paste
End If
Next col
End Sub
Autres conseils
Je pense que cela va faire ce que vous décrivez. Sinon, vous pourriez peut-être expliquer un peu plus clairement?
Dim LastCol As Integer, c As Integer, r As Long LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column For c = 2 To LastCol If Cells(1, c) <> "" Then ActiveSheet.Range(Chr$(64 + c) & "1", ActiveSheet.Range(Chr$(64 + c) & "1").End(xlDown)).Select Selection.Cut ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select ActiveSheet.Paste End If Next c
Sub go() Dim LastCol As Integer, c As Integer, r As Long LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column For c = 2 To LastCol If Cells(1, c) "" Then ActiveSheet.Range(ColumnLetter(c) & "1", ActiveSheet.Range(ColumnLetter(c) & "1").End(xlDown)).Select Selection.Cut ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select ActiveSheet.Paste End If Next c End Sub Function ColumnLetter(ColumnNumber As Integer) As String If ColumnNumber > 26 Then ' 1st character: Subtract 1 to map the characters to 0-25, ' but you don't have to remap back to 1-26 ' after the 'Int' operation since columns ' 1-26 have no prefix letter ' 2nd character: Subtract 1 to map the characters to 0-25, ' but then must remap back to 1-26 after ' the 'Mod' operation by adding 1 back in ' (included in the '65') ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _ Chr(((ColumnNumber - 1) Mod 26) + 65) Else ' Columns A-Z ColumnLetter = Chr(ColumnNumber + 64) End If End Function
Une autre approche, est d'utiliser les chiffres directement, mais je ne me souviens comment faire ... Vive!
-Stuart
Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow