Insertar filas y copiar formato

Anala · Dec 1, 2003

Hola a todos!!!!

Soy bastante nueva en lo que se refiere a VBA y macros en excel, asi que espero que me puedan ayudar con esto....
Resulta que tengo dos hojas en excel, una en donde ingreso ciertos datos(nombre y descripciones de productos) en varias tablas ordenadas hacia abajo y la otra en la que se me copian estos datos en tablas y luego mediante la formula Vlookup busca precios en una base de datos. Lo que quiero hacer es insertar un boton en la primera hoja y cuando le doy clik inserte una fila al final de la tabla (con las mismas formulas de la fila anterior) y que esto mismo pase en la segunda hoja. La idea es que cuando la presona necesite ingresar mas productos y no tenga espacio en la tabla, pueda insertar cuantas filas sean necesarias.

Llevo bastante tiempo tratando de solucionar esto, mis conocimientos no dan para tanto....espero me puedan ayudar.

Saludos...Anala

Greg Truby · Dec 5, 2003

¡Bienvenido a MrExcel! ¿Le comprendo bien? ¿Están sus hojas organizadas como así?

Hoja1

Tabla 1
Nombre1 Descripción1
Nombre2 Descripción2
Nombre3 Descripción3
Nombre4 Descripción4
Nombre5 Descripción5

Tabla 2
Nombre1 Descripción1
Nombre2 Descripción2

Tabla 3
Nombre1 Descripción1
Nombre2 Descripción2
Nombre3 Descripción3

Hoja2

Tabla 1
Nombre1 Precio1
Nombre2 Precio2
Nombre3 Precio3
Nombre4 Precio4
Nombre5 Precio5

Tabla 2
Nombre1 Precio1
Nombre2 Precio2

Tabla 3
Nombre1 Precio1
Nombre2 Precio2
Nombre3 Precio3

Anala · Dec 9, 2003

Hola Greg...gracias por la bienvenida.

Exactamente así están organizadas mis hojas, lo que necesito entonces es incluir un boton al final de cada tabla para dar la opción de agregar una fila al final de la tabla en caso de que el usuario necesite ingresar mas productos. A su vez esto mismo debe pasar en la tabla de la segunda hoja.

Espero me puedas ayudar....gracias y saludos

Anala

Greg Truby · Dec 17, 2003

Anala,

Discuple haber tardado tanto en responder. Quisiera saber ¿Por qué tiene los precios en otra hoja? ¿Habrá algo malo en tenerlos en la misma hoja que las descripciones? Le pregunto porque quisiera proponerle una idea que mantendría estas en la misma hoja pero daría el usuario la habilidad de facilmente esconder uno o el otro.

Anala · Dec 18, 2003

Greg,

Los precios los tengo en otra hoja ya que esta hoja es un resumen donde ademas se entregan los costos y margenes de cada producto. Estos costos y margenes no los puede ver ell usuario común, por eso estan escondidos y la hoja esta protegida. Ademas, en la hoja donde elijo los productos, aparte de mostrarme la descripcion de cada prodcuto, me entrega otras caracteristicas que si las tuviera todas juntas en una sola hoja junto con lo precios, sería una tabla muy grande y la idea es que no sobrepase la pantalla para que los clientes la puedan leer facilmente.

Lo que habia pensado yo es que quizas en la hoja donde ingreso los productos, en vez de agregar una linea, se desescondiera una (unhide), y en la hoja de resumen ya existiera y si luego me sobran lineas las puedo esconder con la funcion zerohide. El problema es que tampoco se como desesconder una por una cada linea al final de la tabla.

Espero me haya entendido...y muchas gracias

Saludos :wink:

Anala

Greg Truby · Dec 19, 2003

Part 1 of 2 posts

Bueno, Anala,

Usted ya dijo que es bastante nueva para VBA y lo siento pero la solución es un poco detallado. Pero trataré de no asustarle.

1. Añada un botón (CommandButton) a cada una de las dos hojas. En mi caso puse el nombre de CmdBtnInsertRows a cada uno y una etiqueta (caption) de "Insertar Filas". Para funcionar mejor tendría que congelar su pantalla en una de las filas debajo del botón para que el usuario lo puede ver todo el tiempo. Entre las propiedades de cada botón, arregle TakeFocusOnClick a FALSE. Y probablemente, PrintObject a FALSE.

2. En los Code Modules para las hojas ponga el código que sigue.

Comentario 1: Note que en mi programación he referido a las hojas con su CodeName. No sé si su versión de Excel pondrá CodeNames de «Hoja1», «Hoja2»... o «Sheet1», «Sheet2»... En mi ejemplo asigné CodeNames de Hoja1 y Hoja2. Hoja1 siendo la hoja para el público y Hoja2 siendo la hoja que contiene los precios y otros datos que usted no desea compartir, pero realmente no importa cual es cual mientra una tiene el CodeName Hoja1 y la otra Hoja2. La utilización de CodeName brinda programación más resistente porque el usuario (o usted) puede cambiar el nombre de la hoja o a posición de la hoja sin afectar el CodeName. Si quiere saber más busque CodeName en VBA Help.

Comentario 2: Agregue programación para tratar de mantener sus dos hojas sincronizadas. Pero la parte clave para que el programa puede funcionar es que hay una clave que será única para cada artículo algo como número de pieza (Part Number) o número de modelo (Model Number). Algo que no aparecerá dos veces en la misma hoja pero debe estar en ambas.

Bueno, aquí está el código para las dos hojas:

' Worksheet Code Module for Hoja1

'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Private Sub CmdBtnInsertRows_Click()
'______________________________________________________________________________

 InsertarDosVeces Me
End Sub

'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Private Sub Worksheet_Change(ByVal Target As Range)
'______________________________________________________________________________

' La programación aquí trata de mantener los dos listados:
' Hoja1 y Hoja 2 sincronizados.

' Si ha seleccionado más que una celda, brinque,
' o si ha seleccionado fuera de la primera columna, brinque.
' Si su valor clave está en otra columna tendrá que cambiar
' la segunda condición abajo para que corresponda a tal columna
' ej: ...Or Target.Column <> 3... si fuera la tercera columna

' La tercera condición correspondría al número de filas de cabeza
' que tiene Hoja1. O sea que cambios a celdas en columna A de
' estas filas no se debe estar copiados a Hoja2.

 If Target.Count > 1 _
 Or Target.Column > 1 _
 Or Target.Row < 3 Then GoTo Jump1

 Dim rngCell As Range, rngCol As Range
 Dim rngQueBusco As Range, intOffsetBack As Integer
 Dim strMensaje As String

 Set rngCol = Hoja2.Columns("A:A")

 If Target.Offset(-1).Formula <> "" Then
 Set rngQueBusco = Target.Offset(-1)
 intOffsetBack = 1
 ElseIf Target.Offset(1).Formula <> "" Then
 Set rngQueBusco = Target.Offset(1)
 intOffsetBack = -1
 Else
 strMensaje = "La celda arriba y la abajo están vacios. Cualquier cambio " & _
 "en esta celda no estará copiado a " & Hoja2.Name & "."
 MsgBox strMensaje, vbExclamation, "Celdas Vacias"
 GoTo Jump1
 End If

 Set rngCell = rngCol.Find(What:=rngQueBusco, _
 After:=rngCol.Cells(1, 1), _
 LookIn:=XlFindLookIn.xlValues, _
 LookAt:=XlLookAt.xlWhole, _
 SearchOrder:=XlSearchOrder.xlByRows, _
 SearchDirection:=xlNext, _
 MatchCase:=False)

 Application.EnableEvents = False
 If Not rngCell Is Nothing Then rngCell.Offset(intOffsetBack) = Target
 Application.EnableEvents = True

Jump1:
'"""""

 ' si hay otra programación deseada póngala aquí
End Sub



<hr>

' Worksheet Code Module for Hoja2

'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Private Sub CmdBtnInsertRows_Click()
'______________________________________________________________________________

 InsertarDosVeces Me
End Sub

'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Private Sub Worksheet_Change(ByVal Target As Range)
'______________________________________________________________________________

' La programación aquí trata de mantener los dos listados:
' Hoja1 y Hoja 2 sincronizados.

' Si ha seleccionado más que una celda, brinque,
' o si ha seleccionado fuera de la primera columna, brinque.
' Si su valor clave está en otra columna tendrá que cambiar
' la segunda condición abajo para que corresponda a tal columna
' ej: ...Or Target.Column <> 3... si fuera la tercera columna

' La tercera condición correspondría al número de filas de cabeza
' que tiene Hoja1. O sea que cambios a celdas en columna A de
' estas filas no se debe estar copiados a Hoja2.

 If Target.Count > 1 _
 Or Target.Column > 1 _
 Or Target.Row < 3 Then GoTo Jump1

 Dim rngCell As Range, rngCol As Range
 Dim rngQueBusco As Range, intOffsetBack As Integer
 Dim strMensaje As String

 Set rngCol = Hoja1.Columns("A:A")

 If Target.Offset(-1).Formula <> "" Then
 Set rngQueBusco = Target.Offset(-1)
 intOffsetBack = 1
 ElseIf Target.Offset(1).Formula <> "" Then
 Set rngQueBusco = Target.Offset(1)
 intOffsetBack = -1
 Else
 strMensaje = "La celda arriba y la abajo están vacios. Cualquier cambio " & _
 "en esta celda no estará copiado a " & Hoja1.Name & "."
 MsgBox strMensaje, vbExclamation, "Celdas Vacias"
 GoTo Jump1
 End If

 Set rngCell = rngCol.Find(What:=rngQueBusco, _
 After:=rngCol.Cells(1, 1), _
 LookIn:=XlFindLookIn.xlValues, _
 LookAt:=XlLookAt.xlWhole, _
 SearchOrder:=XlSearchOrder.xlByRows, _
 SearchDirection:=xlNext, _
 MatchCase:=False)

 Application.EnableEvents = False
 If Not rngCell Is Nothing Then rngCell.Offset(intOffsetBack) = Target
 Application.EnableEvents = True

Jump1:
'"""""

 ' si hay otra programación deseada póngala aquí
End Sub



<hr>
End of Post 1

Greg Truby · Dec 19, 2003

Part 2 of 2 Posts

Ahora tiene que poner el código abajo en un Standard Module.

Partes de este de abajo y lo de arriba viene de rutinas que ya había hecho hace mucho tiempo para mi propio uso entonces es una mezcla de inglés y español a veces. Espero que pueda entender y ojalá que le ayude.

Option Explicit

'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Sub InsertarDosVeces(wsTarget As Worksheet)
'______________________________________________________________________________

 ' Escrito por: Greg Truby
 ' Fecha hecha: Diciembre 2003

 Dim rngLlave As Range, rngGemelo As Range
 Dim wsPadreDelGemelo As Worksheet
 Dim strMensaje As String, lngRowsInserted As Long

 ' Si su valor clave está en otra columna tendrá que cambiar
 ' el segundo argumento abajo para que corresponde a tal columna
 Set rngLlave = Cells(ActiveCell.Row, 1)

 If rngLlave.Formula = "" Then
 strMensaje = "Para funcionar, el macro necesita que usted esté ubicado en " & _
 "una celda que contiene datos. Colóquese en la celda debajo de la " & _
 "cual usted desea que aparezcan las filas nuevas."
 MsgBox strMensaje, vbCritical, "Selección Erronea"
 Exit Sub
 End If

 If wsTarget Is Hoja1 Then
 Set wsPadreDelGemelo = Hoja2
 Else
 Set wsPadreDelGemelo = Hoja1
 End If

 lngRowsInserted = InsertAndCopyRow
 If lngRowsInserted = 0 Then Exit Sub
 Set rngGemelo = wsPadreDelGemelo.Cells.Find(rngLlave)

 If rngGemelo Is Nothing Then
 strMensaje = "No se encuentra " & rngLlave & " en hoja " & wsPadreDelGemelo.Name & "." & _
 vbCr & vbCr & "Tendrá que insertar la filas manualmente."
 MsgBox strMensaje, vbInformation, "Failed Search"
 Exit Sub
 End If

 wsPadreDelGemelo.Activate
 rngGemelo.Select
 InsertAndCopyRow lngRowsInserted
 wsTarget.Activate
 rngLlave.Select

End Sub

'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Function InsertAndCopyRow(Optional lngNumOfRows As Long = 0) As Long
'______________________________________________________________________________

' Generalized subroutine to insert rows, copying formats and formulas
' into the newly inserted rows.

 If TypeName(Selection) <> "Range" Then BadSelectionMessage "InsertAndCopyRow", TypeName(Selection)

 InsertAndCopyRow = 0 ' Default return value

 Dim rngRow As Range, rngToCopy As Range, rngTarget As Range
 Dim lngRow As Long

 If lngNumOfRows = 0 Then lngNumOfRows = InputBox("How many rows do you wish to insert and copy?", _
 "Number of Rows", Selection.Rows.Count)
 If lngNumOfRows = 0 Then Exit Function

 Set rngRow = ActiveCell
 lngRow = rngRow.Row - rngRow.CurrentRegion.Cells(1, 1).Row + 1
 Set rngToCopy = rngRow.CurrentRegion.Range(Cells(lngRow, 1), Cells(lngRow, rngRow.CurrentRegion.Columns.Count))

 Application.EnableEvents = False
 rngToCopy.Offset(1, 0).Resize(lngNumOfRows).EntireRow.Insert
 Set rngTarget = rngToCopy.Offset(1, 0).Resize(lngNumOfRows)
 rngToCopy.Copy Destination:=rngTarget
 On Error Resume Next
 rngTarget.SpecialCells(xlCellTypeConstants).ClearContents
 Application.EnableEvents = True
 InsertAndCopyRow = lngNumOfRows
End Function

'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Sub BadSelectionMessage(CallingRoutine, SelectionType As String)
'______________________________________________________________________________

' Generic subroutine to call when user has tried to run a macro that uses
' selected range as a starting point and a chart, shape or other object
' is currently selected.

 Dim Mensaje As String
 Mensaje = CallingRoutine & " only works with range objects." & vbCrLf & vbCrLf & _
 "Currently a " & SelectionType & " is selected."
 Beep
 MsgBox Mensaje, vbCritical, "Invalid Selection"
 End
End Sub

Anala · Dec 24, 2003

Greg:

Gracias!!!...me costo un poco pero lo logre...tuve que hacer algunos cambios pero al final funciona....muchas gracias por tu ayuda, gacias a ti por fin termine mi trabajo...

ahora a celebrar!!!

Saludos y feliz navidad!!!
Analaura Aguilar S.

Insertar filas y copiar formato

Anala

New Member

Excel Facts

Greg Truby

MrExcel MVP

Anala

New Member

Greg Truby

MrExcel MVP

Anala

New Member

Greg Truby

MrExcel MVP

Greg Truby

MrExcel MVP

Anala

New Member

Similar threads

Forum statistics

Share this page

Insertar filas y copiar formato

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

MrExcel MVP

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock