insertar filas multiples

[Uge21]

Hola, soy Euge , es la primera vez que uso Mr.excel.
Necesito saber como puedo insertar filas una por medio, Es decir que me deje la fila 1, inserte la 2, la que era dos pasa a ser 3, me inserta la 4 y (la que al principio era 3 que da en 5)...y asi sucesivamente.quedarian todas las filas pares en blanco.
Gracias por su ayuda, espero me entiendan ...esto me esta complicando :x y nose como hacerlo y es una lista muy larga .

EStoy esperando su respuesta

 

[galileogali]

Mira esta macro, parte de la siguiente premisa:
que antes de activarla has de ahebrte posicionado (seleccionado) una celda ocupada de la primera fila de la tabla a procesar.

Teniendo la tabla a la vista podria optimizarse mucho mas la macro...pero bueno si tienes paciencia, excel se encargara de tu tarea

Sub intercalar()
Dim direc As String

direc = ActiveCell.Address


Do
ActiveCell.Offset(1, 0).EntireRow.Select
Selection.Insert Shift:=xlDown
i = i + 2
Range(direc).Offset(i, 0).Activate

Loop Until Application.WorksheetFunction.CountA(ActiveCell.EntireRow) = 0

End Sub


GALILEOGALI

 

[Greg Truby]

Hola Euge y bienvenido a MrExcel. ¿Conoce usted VBA? Si sí, qué bien. Si no, háganos saber y explicaremos cómo usar macros.

Bueno Galí ya le ha provisto un macro que le servirá. Aquí le doy un macrocito que escribí hace años para hacer eso. Las diferencias son que el mío le da la opción de decir la altura deseada y si uno no selecciona las celdas antemano se agarra el bloque de celdas de la «región corriente» ("Current Region").

Sub InsertEveryOtherRow()

    Dim rngSelection As Range, rngToChange As Range, rngRowOne As Range
    Dim sngDesiredHeight As Single, lngRowCount As Integer, i&
    
    Set rngSelection = Selection
    With rngSelection
        If .Rows.Count = 1 And .Columns.Count = 1 Then
            Set rngToChange = .CurrentRegion
        Else
            Set rngToChange = rngSelection
        End If
    End With
    With rngToChange
        Set rngRowOne = .Rows(1)
        lngRowCount = .Rows.Count
    End With
    On Error GoTo Salida
    sngDesiredHeight = InputBox("Enter a desired height for the new rows", "Height", rngRowOne.Height)

    For i = 1 To lngRowCount * 2 - 3 Step 2
        With rngRowOne
            .Offset(i, 0).EntireRow.Insert
            .Offset(i, 0).RowHeight = sngDesiredHeight
        End With
    Next i
Salida:
'""""""
    '// Error generated -- just leave.
    '// [Most likely cause is hitting Cancel at the input box.]
End Sub

Atte,

 

[galileogali]

Greg , Excelente!!!.
Interesante este paso, como para usarlo en otros casos diferentes:

If .Rows.Count = 1 And .Columns.Count = 1 Then
Set rngToChange = .CurrentRegion
Else
Set rngToChange = rngSelection
End If

Bye!!!

 

[Greg Truby]

Uy actualmente como indico arriba escribí esto hace años. Realmente

If .Rows.Count = 1 And .Columns.Count = 1 Then

podía haber sido

If .Count = 1 Then

Al verlo pensé que tal vez lo escribí así por que había algo raro con celdas unidas (merged cells). Pero acabo de verificar que .Count devuelve un número mayor que uno para celdas unidas. Entonces no tengo ni la menor idea porque hice una comparación doble en vez de una sencilla.

 

[galileogali]

Saltee el asunto sin darme cuenta de que se podia sintetizar, sino simplemente resaltaba la posibilidad de definir el Rango teniendo en cuenta mayo interfaz de usuario o en forma más prescindente de su participación....


GALI

 

[Greg Truby]

Si, entendí. Nada más es que cuando uno está proveendo código a veces la gente ve algo así y piensa que uno debe hacer las cosas así y resulta que uno les ha enseñado algo malo.

Otra cosita que hago y saqué el código para simplificar el asunto es que trato de cuidar contra errores que se genera si la selección no es un rango. Algo como

if lcase(typename(selection))<>"range" then
    msgbox "range not selected", vbcritical,"bad selection"
    exit sub
end if

A veces se puede utilizar ActiveCell en vez de Selection si Selection no es un rango. Pero por lo general simplemente aborto la rutina porque si es un control o una forma seleccionado, puede ser que el rango que uno agarraría con ActiveCell.CurrentRegion sería erróneo.

Saludos,

 

[galileogali]

Aunque no se me ocurre como integrarla a tu codigo en este momento, pero creo que podrias tambien analizar la posibilidad de la Propiedad
Rangeselection, ya que devuelve exclusivamente cells......
Pero, bueno, ya serìa pensar que el usario esta jugando en la planilla.....

GALI

 

[galileogali]

Aunque no se me ocurre como integrarla a tu codigo en este momento, pero creo que podrias tambien analizar la posibilidad de la Propiedad
Rangeselection, ya que devuelve exclusivamente cells......
Pero, bueno, ya serìa pensar que el usario esta jugando en la planilla.....

GALI

 

[Greg Truby]

¡Ay, Galí, qué buena idea! Había visto eso de RangeSelection hace años cuando estuve revisando el objeto ActiveWindow/Window después de haber aprendido donde demonios uno se da cuenta de cuales hojas están seleccionados. Pero se me había olvidado de eso completamente. Ya hice un cambio a la rutina mía. Ahora se ve así:

Sub InsertEveryOtherRow()
    
    Dim rngSelection As Range, rngToChange As Range, rngRowOne As Range, strMsg As String
    Dim sngDesiredHeight As Single, lngRowCount As Integer, i&, booVerify As Boolean
    
    If TypeName(Selection) = "Range" Then
        Set rngSelection = Selection
        booVerify = False
    Else
        Set rngSelection = ActiveWindow.RangeSelection
        booVerify = True
    End If
    
    With rngSelection
        If .Count = 1 Then
            Set rngToChange = .CurrentRegion
        Else
            Set rngToChange = rngSelection
        End If
    End With
    If booVerify Then
        strMsg = "Currently a " & TypeName(Selection) & " is selected." _
               & vbCr & vbCr & "The range that will be used is:" _
               & vbCr & vbCr & vbTab & rngToChange.Address(False, False) _
               & vbCr & vbCr & "Is this the desired range?"
        If vbNo = MsgBox(strMsg, vbQuestion + vbYesNo, "Verify Address") Then Exit Sub          ' |--¿xsub?-->
    End If
    With rngToChange
        Set rngRowOne = .Rows(1)
        lngRowCount = .Rows.Count
    End With
    On Error GoTo Salida
    sngDesiredHeight = InputBox("Enter a desired height for the new rows", "Height", rngRowOne.Height)

    For i = 1 To lngRowCount * 2 - 3 Step 2
        With rngRowOne
            .Offset(i, 0).EntireRow.Insert
            .Offset(i, 0).RowHeight = sngDesiredHeight
        End With
    Next i
Salida:
'""""""
    '// Error generated -- just leave.
    '// [Most likely cause is hitting Cancel at the input box.]
End Sub

Otra vez, le agradezco por la idea. ¡Muchas Gracias!

Ahora me pregunto ¿adonde fue Euge quien inició esta conversación?...