Macro para copiar y pegar con condición
No se nada de macros pero encontré una que hace lo que necesito, pero el asunto es que necesito que lleve una condición.
Tengo 3 departamentos en los cuales manejo un inventario, los dptos son identificados como 100, 200, 300. Todo el inventario de los tres dptos estan en una sola hoja, lo que necesito es que copie los datos que le pertenecen a cada dpto en hojas separadas que ya las tengo creada y se llaman igual (100, 200, 300), esto para tener un control de lo que tengo en cada dpto.
Copio el codigo, no se si se puede hacer con este mismo o tienes otro ejemplo.
Sub CopiarCeldas()
'Definir objetos a utilizar
Dim wsOrigen As Excel.Worksheet, _
wsDestino As Excel.Worksheet, _
rngOrigen As Excel.Range, _
rngDestino As Excel.Range
'Indicar las hojas de origen y destino
Set wsOrigen = Worksheets("Origen")
Set wsDestino = Worksheets("Destino")
'Indicar la celda de origen y destino
Const celdaOrigen = "A1"
Const celdaDestino = "A1"
'Inicializar los rangos de origen y destino
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
'Seleccionar rango de celdas origen
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Pegar datos en celda destino
rngDestino.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
1 Respuesta
H o l a: Te preparo una macro nueva, pero dime lo siguiente:
- En cuál columna está el departamento.
- Cómo se llama la hoja con los datos.
- En qué fila empiezan los datos.
- Qué columnas se van a copiar, es decir, si en la fila 5 tienes el depto 100, cuáles columnas de la fila 5 voy a copiar.
- En dónde se van a pegar, de igual forma, si copié las columnas A, B, C, D y E de la fila 5 de la hoja con datos y las voy a pegar en la hoja 100, en dónde las quieres, también las quieres en las columnas A, B, C, D y E
- Por último, en cuál fila de la hoja destino quieres pegar la información.
E spero tus comentarios en ese orden.
Sal u dos
Muchas gracias por tu apoyo.
Respuestas a tus preguntas ...
1. El dpto esta en la columna D
2. La hoja se llama Inventario
3. Los datos empiezan en la fila 2, ya que la fila uno contiene los encabezados de las columnas
4. Las columnas que se van a copiar son E,F,G,H
5. Al momento de pegar, que se peguen en las columnas A,B,C y D
6. Al pegar la información, que empiece en la fila 2
Te informo también que la cantidad de referencias del inventario por dpto es bastante, para que al momento que crees la macro tienes que tomar en cuenta por ejemplo que del dpto 100 son 300 productos, del dpto 200 son 150 y del 300 son 600. Esto es solo un ejemplo ya que las cantidades varian.
Nuevamente muchas gracias
Te anexo la macro. Antes debes verificar que tus hojas de deptos se llamen 100,200 y 300
Si quieres agregar más deptos, puedes ponerlos en esta línea:
Deptos = Array("100", "200", "300")El dato que pongas en esa línea, así también deberá llamarse la hoja.
El pegado se realizará a partir de la fila 2, eso significa que los datos que ya tenga la hoja, serán reemplazados por los que tenga la hoja "inventario".
Sub Copiar_Inventario()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Inventario")
deptos = Array("100", "200", "300")
For d = LBound(deptos) To UBound(deptos)
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u = h1.Range("D" & Rows.Count).End(xlUp).Row
h1.Range("D1:H" & u).AutoFilter Field:=1, Criteria1:=deptos(d)
u = h1.Range("D" & Rows.Count).End(xlUp).Row
h1.Range("E2:H" & u).Copy Sheets(deptos(d)).Range("A2")
Next
If h1.AutoFilterMode Then h1.AutoFilterMode = False
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
