Tengo esta macro hecha perfecta y necesito agregar unos parámetros
Tengo esta macro hecha perfecta :
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
ActiveSheet.Unprotect Password:="1"
If Not Intersect(Target, Range("B6:B20")) Is Nothing Then
filas = Target.Rows.Count
Application.EnableEvents = False
Range("B" & Target.Row & ":G" & Target.Row + filas - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Application.EnableEvents = True
ActiveSheet.Unprotect Password:="1"
Range("E20:E34").HorizontalAlignment = xlLeft
End If
Range("B6").Select
End Sub
1º/ PASO : Cuando agrego cuatro líneas, tengo que buscar la celda "B16" y pegar, perfecto.
A medida que voy a agregar más líneas tengo que contar las líneas para agregar
todo perfecto
Pregunto si se puede hacer
1º paso : pegar siempre en la celda "b6", y que la primera línea escrita se coloque
en la celda "b20".
2º paso : que se supriman las celdas vacías que queden por debajo de la celda "b20"
Te mando el archivo a tu correo Dante
Un abrazo
1 Respuesta
Lo he conseguido, y a demás he conseguido para convertir a numero las celdas que quiera, en este caso en un rango que necesitaba.
La macro me queda así :
Private Sub Worksheet_Change(ByVal Target As Range)
' Para quitar el espacio+letras
Range("F5:G19").Replace What:=" EUR", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Alinear a la izquierda
Range("E6:E19").HorizontalAlignment = xlLeft
' Convertir a Numero
Range("F5:G19").Select
For Each cd In Selection
On Error Resume Next
'si Val devuelve 0 es porque se trata de celdas con texto, no nros guardados como texto
If Val(cd) <> 0 Then
cd.Value = cd.Value * 1
End If
Next
' Ingresar filas vacias
Range("B6:G19").Select
Selection.Insert Shift:=xlDown
' Elimnar filas vacias
Range("B20:G40").Cells.SpecialCells(xlCellTypeBlanks).Delete xlUp
Range("B6").Select
End Sub
Un saludo a todos y muchas gracias por este foro.
Me están ayudando mucho Dante y Elsa
