Acomodar columnas debajo de los nombres en las hojas de MIcrosoft Excel
Hola Hugolaza un fovor, estoy trancado en este problema.
Tengo este código en la Hoja 1
Private Sub Worksheet_Deactivate()
Sheets("Hoja2").Rows("5:2").ClearContents
For a = 1 To 51
If Range("B5").Offset(a, 0) <> "" Then
b = b + 1
Sheets("Hoja2").Range("A5").Offset(0, b) = Range("B5").Offset(a, 0)
End If
Next a
End Sub
lo que hace es acomodar de forma horizontal los nombres q yo escojo de una lista q tengo en la hoja1, aun cuando haya una fila vacia, este lo acomoda en la hoja 2 de forma continua. Funciona a la perfección. Pero sabes? En la hoja 2 debajo de los nombres voy colocando datos numericos, masomenos unas 20 celdas por debajo de cada uno, el problema es que si en la hoja1 en una espacio vacio yo me olvidé un nombre y lo adiciono, en la Hoja2 se acomoda, osea q se incluye el nombre, pero los datos q estan por dabajo no recorren, solo se mueven los encabezados, y no los datos q estan por debajo, como puedo hacer para q se acomode toda la columna por deba de los nombres?
Gracias por atenderme
Tengo este código en la Hoja 1
Private Sub Worksheet_Deactivate()
Sheets("Hoja2").Rows("5:2").ClearContents
For a = 1 To 51
If Range("B5").Offset(a, 0) <> "" Then
b = b + 1
Sheets("Hoja2").Range("A5").Offset(0, b) = Range("B5").Offset(a, 0)
End If
Next a
End Sub
lo que hace es acomodar de forma horizontal los nombres q yo escojo de una lista q tengo en la hoja1, aun cuando haya una fila vacia, este lo acomoda en la hoja 2 de forma continua. Funciona a la perfección. Pero sabes? En la hoja 2 debajo de los nombres voy colocando datos numericos, masomenos unas 20 celdas por debajo de cada uno, el problema es que si en la hoja1 en una espacio vacio yo me olvidé un nombre y lo adiciono, en la Hoja2 se acomoda, osea q se incluye el nombre, pero los datos q estan por dabajo no recorren, solo se mueven los encabezados, y no los datos q estan por debajo, como puedo hacer para q se acomode toda la columna por deba de los nombres?
Gracias por atenderme
Respuesta de hugolaza
1
Un poco complicado tu pedido.
Copia esta rutina en códigos de la Hoja 1
Private Sub Worksheet_Deactivate()
Open "c:\tem.txt" For Output As #1
For a = 1 To 51
If Range("B5").Offset(a, 0) <> "" Then
b = b + 1
Write #1, Range("B5").Offset(a, 0)
End If
Next a
Close
End Sub
Y esta rutina en codigos de la Hoja 2
Private Sub Worksheet_Activate()
On Error Resume Next
Open "c:\tem.txt" For Input As #1
Range("B5").Select
Do While Not EOF(1)
Input #1, nombre
col = 0
Do While ActiveCell.Offset(0, col) <> ""
If ActiveCell.Offset(0, col) = nombre Then
Existe = 1
Exit Do
Else
col = col + 1
End If
Loop
If ActiveCell <> nombre And Existe = 0 Then
Selection.EntireColumn.Insert
ActiveCell = nombre
Rem Exit Do
End If
Existe = 0
ActiveCell.Offset(0, 1).Select
Loop
Close
Kill "c:\tem.txt"
End Sub
Copia esta rutina en códigos de la Hoja 1
Private Sub Worksheet_Deactivate()
Open "c:\tem.txt" For Output As #1
For a = 1 To 51
If Range("B5").Offset(a, 0) <> "" Then
b = b + 1
Write #1, Range("B5").Offset(a, 0)
End If
Next a
Close
End Sub
Y esta rutina en codigos de la Hoja 2
Private Sub Worksheet_Activate()
On Error Resume Next
Open "c:\tem.txt" For Input As #1
Range("B5").Select
Do While Not EOF(1)
Input #1, nombre
col = 0
Do While ActiveCell.Offset(0, col) <> ""
If ActiveCell.Offset(0, col) = nombre Then
Existe = 1
Exit Do
Else
col = col + 1
End If
Loop
If ActiveCell <> nombre And Existe = 0 Then
Selection.EntireColumn.Insert
ActiveCell = nombre
Rem Exit Do
End If
Existe = 0
ActiveCell.Offset(0, 1).Select
Loop
Close
Kill "c:\tem.txt"
End Sub
Gracias Hugolaza no te conozco pero te admiro mucho, funciona a la perfección, algún día me gustaría que me comentes como haces para saber todo esto, una gran admiración por ti, muchas gracias...
