Enviar datos específicos de una hoja a otra al cumplir una condición

L

leobrice

New Member
Joined
Jun 14, 2024
Messages
37
Office Version
  1. 2013
Platform
  1. Windows
Saludos cordiales amigos de MREXCEL, gracias por aceptar mi suscripción

Tengo un archivo que deseo automatizar 2 procesos, que son muy similares ambos. Les explico:

1. La Hoja Costos Productos Nacionales debe enviar a la hoja Precios Productos y Servicios la información de cada producto ingresado y lo debe hacer al colocar el Precio de Compra (columna E). La información que debe enviar es la contenida en las columnas A, B, C y F a las columnas A, B, C y D de la hoja destino y cursor quedarse en la celda E de esta hoja.

2. La Hoja Costos Productos Importados debe enviar a la hoja Precios Productos y Servicios la información de cada producto ingresado y lo debe hacer al colocar SI en la columna V. La información que debe enviar es la contenida en las columnas A, B, C y W a las columnas A, B, C y D de la hoja destino y cursor quedarse en la celda E de esta hoja.

El código VBA que estoy usando es de otro archivo similar y lo estoy adaptando a éste. Ya logré enviar de ambas hojas de origen las columnas A, B y C, pero me falta la columna F de la primera hoja y la columna W de la segunda. Me podrían brindar su ayuda

Muy agradecido de antemano por su valiosa ayuda.


PRUEBA.xlsm
ABCDEFG
2COSTOS DE PRODUCTOS NACIONALES
3PRODUCTONACIONALUNIDAD DE MEDIDACANTIDAD DE PRODUCTOPRECIO DE COMPRACOSTO PRODUCTO UNITARIO
4#¡REF!#¡REF!
5ACETONANACIONALCaja1.000,00125.000,00125,00por Caja
6LIMPIADOR AZULNACIONALKilo50,00150.000,003.000,00por Kilo
7LIMPIADOR ROJONACIONALUnidad2.000,00250.000,00125,00por Unidad
8BOLSAS PLASTICAS 5 LITROSNACIONALPaquete100,0045.000,00450,00por Paquete
9LIMPIADOR VERDENACIONALLitro5,0050.000,0010.000,00por Litro
10LIMPIADOR AMARILLONACIONALCaja2,0045.000,0022.500,00por Caja
11LIMPIADOR GRISNACIONALUnidad1,0020.000,0020.000,00por Unidad
12CLORONACIONALGalón100,00325.000,003.250,00por Galón
13JABONNACIONALKilo100,00387.000,003.870,00por Kilo
14JABON AZULNACIONALKilo1.200,00500.000,00416,67por Kilo
15JABON AMARILLONACIONALKilo850,00350.000,00411,76por Kilo
16JABON NEGRONACIONALKilo350,00285.000,00814,29por Kilo
17JABON GRISNACIONALKilo1.200,00345.000,00287,50por Kilo
18JABON MARRONNACIONALKilo1.500,00450.000,00300,00por Kilo
19JABON ROJONACIONALKilo2.500,00375.000,00150,00por Kilo
20NACIONAL0,000
21NACIONAL0,000
COSTOS PRODUCTOS NACIONALES
Cell Formulas
RangeFormula
E4:F4E4=#REF!
F5:F21F5=IFERROR(E5/D5,0)
G5:G21G5=C5
Cells with Conditional Formatting
CellConditionCell FormatStop If True
G5:G50Cell Value=0textNO
Cells with Data Validation
CellAllowCriteria
E5:E21Any value
A5:B50Custom=CONTAR.SI($A$5:$A$50;A5)<=1
C5:C50List=UNIDADES


PRUEBA.xlsm
ABCDEFGHIJKLMNOPQRSTUVWX
10,00
2COSTOS DE PRODUCTOS IMPORTADOS
3PRODUCTOIMPORTADOUNIDAD DE MEDIDA (seleccionar)PAÍS DE ORIGENMONEDACANTIDAD DE PRODUCTOCOSTO POR UNIDADTIPO DE CAMBIOTOTAL COMPRA PRODUCTOARANCELESIMPUESTOSSEGUROSFLETESTRANSPORTE NACIONALGASTOS DE NACIONALIZACIONOTROS CONCEPTOS 1OTROS CONCEPTOS 2OTROS CONCEPTOS 3OTROS CONCEPTOS 4OTROS CONCEPTOS 5TOTAL COSTO PRODUCTOCONFIRMAR INFORMACIONCOSTO PRODUCTO UNITARIO
4#¡REF!#¡REF!#¡REF!#¡REF!#¡REF!#¡REF!#¡REF!#¡REF!#¡REF!#¡REF!#¡REF!#¡REF!#¡REF!(SI / NO)#¡REF!
5CLORO PLUSIMPORTADOGalónESTADOS UNIDOSUSD1.000,001,75520,00910.000,001.000,002.000,003.000,005.000,006.000,007.000,00500,00600,00700,00800,00900,00937.500,00SI937,50por Galón
6DETERGENTE PROIMPORTADOBolsaESTADOS UNIDOSUSD600,001,02520,00318.240,001.000,0010,0010,0010,0010,0010,0010,0010,0010,0010,0010,00319.340,00SI532,23por Bolsa
7LIMPIADOR XTRAIMPORTADOBolsaESTADOS UNIDOSUSD600,002,30520,00717.600,001.000,0010,0010,0010,0010,0010,0010,0010,0010,0010,0010,00718.700,00SI1.197,83por Bolsa
8LIMPIADOR XTRA AZULIMPORTADOKiloESTADOS UNIDOSUSD1.000,004,15520,002.158.000,00123,00456,0078,00321,00654,0087,00147,00258,0036,0063,00852,002.161.075,00SI2.161,08por Kilo
9LIMPIADOR XTRA ROJOIMPORTADOKiloESTADOS UNIDOSUSD500,003,85520,001.001.000,00521,00541,00654,00124,00521,00478,00102,00321,00451,00652,00148,001.005.513,00SI2.011,03por Kilo
10LIMPIADOR XTRA AMARILLOIMPORTADOKiloESTADOS UNIDOSUSD1.000,002,95520,001.534.000,00321,00654,00879,00147,0058,00369,00445,00662,0044,00874,0032.541,001.570.994,00SI1.570,99por Kilo
11LIMPIADOR XTRA MARRONIMPORTADOKiloESTADOS UNIDOSUSD500,005,60520,001.456.000,00321,00410,00654,007.410,008.520,006.321,00654,00321,00854,00658,0032.014,001.514.137,00SI3.028,27por Kilo
12LIMPIADOR XTRA GRISIMPORTADOKiloESTADOS UNIDOSUSD300,004,75520,00741.000,00545,00545,005.645,00454,00454,00545,006.454,00654,0011,00123,00541,00756.971,00SI2.523,24por Kilo
13IMPORTADO 0,000,000,000
14IMPORTADO 0,000,000,000
15IMPORTADO 0,000,000,000
16IMPORTADO 0,000,000,000
COSTOS PRODUCTOS IMPORTADOS
Cell Formulas
RangeFormula
A1A1='INFORMACION GENERAL'!D5
W4,I4:U4J4=#REF!
W5:W10W5=IF(V5="SI",IFERROR(U5/F5,0),0)
X5:X16X5=C5
W11:W16W11=IFERROR(U11/F11,0)
E13:E16E13=IFERROR(VLOOKUP(D13,#REF!,2)," ")
I5:I16I5=F5*G5*H5
U5:U16U5=SUM(I5:T5)
Cells with Conditional Formatting
CellConditionCell FormatStop If True
X5:X50Cell Value=0textNO
Cells with Data Validation
CellAllowCriteria
U5:V16Any value
A5:B50Custom=CONTAR.SI($A$5:$A$50;A5)<=1
C5:C50List=UNIDADES
D5:D50List=PAISES



PRUEBA.xlsm
ABCDE
10,00
2PRECIO DE VENTA DE PRODUCTOS Y SERVICIOS
3PRODUCTO / SERVICIONACIONAL o IMPORTADOUNIDAD DE MEDIDACOSTO UNITARIO PRODUCTOVENTAS ESTIMADAS MENSUALES UNIDADES
4
5#¡REF!0
6ACETONANACIONALCaja125,00
7LIMPIADOR AZULNACIONALKilo3.000,00
8LIMPIADOR ROJONACIONALUnidad125,00
9BOLSAS PLASTICAS 5 LITROSNACIONALPaquete450,00
10LIMPIADOR VERDENACIONALLitro10.000,00
11LIMPIADOR AMARILLONACIONALCaja22.500,00
12LIMPIADOR GRISNACIONALUnidad20.000,00
13CLORONACIONALGalón3.250,00
14JABONNACIONALKilo3.870,00
15CLORO PLUSSIGalón937,50
16DETERGENTE PROSIBolsa532,23
17LIMPIADOR XTRAIMPORTADOBolsa1.197,83
18JABON AZULNACIONALKilo0,00
19LIMPIADOR XTRA AZULIMPORTADO
20JABON AMARILLONACIONALKilo0,00
21LIMPIADOR XTRA ROJOIMPORTADO
22LIMPIADOR XTRA AMARILLOIMPORTADOKilo0,00
23LIMPIADOR XTRA MARRONIMPORTADOKilo0,00
24JABON NEGRONACIONALKilo0,00
25JABON GRISNACIONALKilo0,00
26JABON MARRONNACIONALKilo0,00
27LIMPIADOR XTRA GRISIMPORTADOKilo0,00
28JABON ROJONACIONALKilo0,00
29JABON ROJONACIONALKilo0,00
30LIMPIADOR XTRA GRISIMPORTADOKilo0,00
31
32
33
34
PRECIOS PRODUCTOS Y SERVICIOS
Cell Formulas
RangeFormula
A1A1='INFORMACION GENERAL'!D5
D5D5=#REF!
E5E5=SUM(E6:E50)
Cells with Data Validation
CellAllowCriteria
A6:B14Custom=CONTAR.SI($A$5:$A$50;A6)<=1
C6:C17List=UNIDADES
A15:B17Custom=CONTAR.SI($A$5:$A$50;A15)<=1


CODIGO VBA DE COSTOS PRODUCTOS NACIONALES:
Sub EnviarDatosCostosProductosNacionalesAPreciosProductosYServiciosA()
Application.ScreenUpdating = False

Dim ult, ult1 As Long
Dim rng As Range
ult2 = Sheets("COSTOS PRODUCTOS NACIONALES").Range("A" & Rows.Count).End(xlUp).Row
ult3 = Sheets("COSTOS PRODUCTOS NACIONALES").Range("B" & Rows.Count).End(xlUp).Row
ult4 = Sheets("COSTOS PRODUCTOS NACIONALES").Range("C" & Rows.Count).End(xlUp).Row
ult6 = Sheets("COSTOS PRODUCTOS NACIONALES").Range("F" & Rows.Count).End(xlUp).Row

ult = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("A" & Rows.Count).End(xlUp).Row + 1
ult1 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("B" & Rows.Count).End(xlUp).Row + 1
ult5 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("C" & Rows.Count).End(xlUp).Row + 1
ult7 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("D" & Rows.Count).End(xlUp).Row + 1

Application.ScreenUpdating = False
Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("D" & ult1) = Sheets("COSTOS PRODUCTOS NACIONALES").Range("F" & ult6).Value
Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("C" & ult1) = Sheets("COSTOS PRODUCTOS NACIONALES").Range("C" & ult4).Value
Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("B" & ult1) = Sheets("COSTOS PRODUCTOS NACIONALES").Range("B" & ult3).Value
Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("A" & ult1) = Sheets("COSTOS PRODUCTOS NACIONALES").Range("A" & ult2).Value

Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Select

MsgBox ("SE HA ENVIADO AL MODULO PRECIOS PRODUCTOS Y SERVICIOS LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO" & Chr(13) & _
"POR FAVOR COMPLETE LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO " & Chr(13) & _
"OPERACIÓN REALIZADA SATISFACTORIAMENTE"), vbInformation, "CALCULADORA DE PRECIOS Y COSTOS"



Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("E" & ult1).Select

End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 5 Then
If Target.Address Like "$E$*" Then
If Range("E" & Target.Row) > 0 Then
Application.ScreenUpdating = False
Call EnviarDatosCostosProductosNacionalesAPreciosProductosYServiciosA
End If
End If
End If

Dim prod$, ufo&, ufd&
Dim pro_d As Range
Dim rDependents As Range

uf = Range("C" & Rows.Count).End(xlUp).Row
'prod = TempCombo
prod = Range("A" & Target.Row).Value

If Application.Intersect(Target, Range("D5:D" & uf)) Is Nothing And _
Application.Intersect(Target, Range("E5:E" & uf)) Is Nothing Then
Exit Sub
End If

If Worksheets("COSTOS PRODUCTOS NACIONALES").Range("F" & Target.Row).Value > 0 Then
With Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
ufd = .Range("A" & Rows.Count).End(xlUp).Row
Set pro_d = .Range("A5:A" & ufd).Find(prod)
pro_d.Offset(, 1) = Worksheets("COSTOS PRODUCTOS NACIONALES").Range("B" & Target.Row).Value
End With
End If


End Sub


CODIGO VBA DE COSTOS PRODUCTOS IMPORTADOS:
Sub EnviarDatosCostosProductosImportadosAPreciosProductosYServicios()
Application.ScreenUpdating = False

Dim ult, ult1 As Long
Dim rng As Range
ult2 = Sheets("COSTOS PRODUCTOS IMPORTADOS").Range("A" & Rows.Count).End(xlUp).Row
ult3 = Sheets("COSTOS PRODUCTOS IMPORTADOS").Range("B" & Rows.Count).End(xlUp).Row
ult4 = Sheets("COSTOS PRODUCTOS IMPORTADOS").Range("C" & Rows.Count).End(xlUp).Row
ult6 = Sheets("COSTOS PRODUCTOS IMPORTADOS").Range("W" & Rows.Count).End(xlUp).Row

ult = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("A" & Rows.Count).End(xlUp).Row + 1
ult1 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("B" & Rows.Count).End(xlUp).Row + 1
ult5 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("C" & Rows.Count).End(xlUp).Row + 1
ult7 = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("D" & Rows.Count).End(xlUp).Row + 1

Application.ScreenUpdating = False
Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("D" & ult1) = Sheets("COSTOS PRODUCTOS IMPORTADOS").Range("W" & ult6).Value
Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("C" & ult1) = Sheets("COSTOS PRODUCTOS IMPORTADOS").Range("C" & ult4).Value
Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("B" & ult1) = Sheets("COSTOS PRODUCTOS IMPORTADOS").Range("B" & ult3).Value
Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("A" & ult1) = Sheets("COSTOS PRODUCTOS IMPORTADOS").Range("A" & ult2).Value

Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Select

MsgBox ("SE HA ENVIADO AL MODULO PRECIOS PRODUCTOS Y SERVICIOS LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO" & Chr(13) & _
"POR FAVOR COMPLETE LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO" & Chr(13) & _
"POR FAVOR COMPLETE LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO " & Chr(13) & _
"OPERACIÓN REALIZADA SATISFACTORIAMENTE"), vbInformation, "CALCULADORA DE PRECIOS Y COSTOS"



Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("E" & ult1).Select

End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 5 Then
If Target.Address Like "$V$*" Then
If Range("V" & Target.Row) > 0 Then
Application.ScreenUpdating = False
Call EnviarDatosCostosProductosImportadosAPreciosProductosYServicios
End If
End If
End If

Dim prod$, ufo&, ufd&
Dim pro_d As Range
Dim rDependents As Range

uf = Range("C" & Rows.Count).End(xlUp).Row
'prod = TempCombo
prod = Range("A" & Target.Row).Value

If Application.Intersect(Target, Range("D5:D" & uf)) Is Nothing And _
Application.Intersect(Target, Range("E5:E" & uf)) Is Nothing And _
Application.Intersect(Target, Range("F5:F" & uf)) Is Nothing And _
Application.Intersect(Target, Range("G5:G" & uf)) Is Nothing And _
Application.Intersect(Target, Range("H5:H" & uf)) Is Nothing And _
Application.Intersect(Target, Range("I5:I" & uf)) Is Nothing And _
Application.Intersect(Target, Range("J5:J" & uf)) Is Nothing And _
Application.Intersect(Target, Range("K5:K" & uf)) Is Nothing And _
Application.Intersect(Target, Range("L5:L" & uf)) Is Nothing And _
Application.Intersect(Target, Range("M5:M" & uf)) Is Nothing And _
Application.Intersect(Target, Range("N5:N" & uf)) Is Nothing And _
Application.Intersect(Target, Range("O5:O" & uf)) Is Nothing And _
Application.Intersect(Target, Range("P5:P" & uf)) Is Nothing And _
Application.Intersect(Target, Range("Q5:Q" & uf)) Is Nothing And _
Application.Intersect(Target, Range("R5:R" & uf)) Is Nothing And _
Application.Intersect(Target, Range("S5:S" & uf)) Is Nothing And _
Application.Intersect(Target, Range("T5:T" & uf)) Is Nothing And _
Application.Intersect(Target, Range("U5:U" & uf)) Is Nothing And _
Application.Intersect(Target, Range("W5:W" & uf)) Is Nothing And _
Application.Intersect(Target, Range("X5:X" & uf)) Is Nothing Then
Exit Sub
End If

If Worksheets("COSTOS PRODUCTOS IMPORTADOS").Range("W" & Target.Row).Value > 0 Then
With Sheets("PRECIOS PRODUCTOS Y SERVICIOS")
ufd = .Range("A" & Rows.Count).End(xlUp).Row
Set pro_d = .Range("A6:A" & ufd).Find(prod)
pro_d.Offset(, 1) = Worksheets("COSTOS PRODUCTOS IMPORTADOS").Range("W" & Target.Row).Value
End With
End If


End Sub
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
You must log in or register to reply here.

Similar threads

L
  • Question Question
2 PROCESSES IN VBA MACROS THAT SHOULD NOT HAPPEN
Replies
2
Views
347
Rhodie72
Rhodie72
J
  • Question Question
Limpieza y Error en Formularios
Replies
0
Views
517
jues
J
L
  • Question Question
MACROS WORK WELL, BUT WHEN I DELETE THE DATA TO LEAVE THE FILE WITHOUT INFORMATION, MACROS DON'T WORK
Replies
1
Views
214
leobrice
L
M
  • Solved
Problema con línea de macro
Replies
4
Views
1K
misssalsa
M
L
  • Solved
Updating data in cell, run the macro again and it should not happen.
2 3 4
Replies
34
Views
1K
mumps
mumps

Forum statistics

Threads
1,224,818
Messages
6,181,151
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top