Visual Basic Mover todas las demás columnas para crear una columna larga B
-
27-10-2019 - |
Pregunta
Tengo una serie de columnas de datos, cada una de 15 filas de profundidad. La columna B es la columna que quiero mover todas las demás columnas debajo en orden. Entonces, el contenido de la columna C se corta y se mueve debajo de eso ya en B y así sucesivamente.
Hasta ahora tengo;
'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
Necesito el bucle para que funcione, recorriendo todas las columnas de A a FN.
Gracias por adelantado.
Solución
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
Otros consejos
Creo que esto hará lo que usted describe. Si no, ¿quizás podrías explicar un poco más claramente?
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
Otro enfoque es usar los números directamente, pero olvido cómo hacer eso ... ¡Salud!
-Sart
Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow