Visual Basic Sposta tutte le altre colonne per creare una lunga colonna B

Question

Ho una serie di colonne di dati, ogni 15 righe profonde. La colonna B è la colonna che voglio spostare tutte le altre colonne sotto in ordine. Quindi il contenuto della colonna C viene tagliato e spostato sotto quello già in B e così via.

Finora ho;

'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

Ho bisogno del ciclo per farlo funzionare, loop attraverso tutte le colonne da A a FN.

Grazie in anticipo.

Answer 1

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

Answer 2

Penso che questo farà quello che descrivi. In caso contrario, forse potresti spiegare un po 'più chiaramente?

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

Answer 3

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

Un altro approccio è usare direttamente i numeri, ma dimentico come farlo ... applausi!

-Stuart