Macro - Buscar un valor con una condición en Hoja3 e insertar automáticamente el mismo valor encontrado en una celda en Hoja2

Queridos expertos necesito una ayuda con esto. Tengo una planilla en Excel con 5 solapas, de las cuales quiero enfocarme en la que dice "Datos"... Como lo dice el titulo estoy buscando datos en distintas solapas, y a su vez necesito que esos datos encontrados se copien en celdas distintas en la Hoja "Datos" y así sucesivamente hacia abajo, la condición es que siempre tenga un dato ingresado (puede ser la fecha) para que se valide la fila.

Actualmente uso esta macro para pasar los datos de la Hoja "Captura" (tipo formulario) a la Hoja "Datos":

Option Explicit
Sub Captura_Datos()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Integer
Dim Limpiar As String
'
strTitulo = "Egreso de Combustibles"
'
Continuar = MsgBox("Dar de alta los datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("Datos").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("Datos")
.Cells(NewRow, 1).Value = ThisWorkbook.Sheets(1).Range("C6")
.Cells(NewRow, 2).Value = ThisWorkbook.Sheets(1).Range("I6")
.Cells(NewRow, 3).Value = ThisWorkbook.Sheets(1).Range("E6")
.Cells(NewRow, 4).Value = ThisWorkbook.Sheets(1).Range("G6")
.Cells(NewRow, 5).Value = ThisWorkbook.Sheets(1).Range("C9")
.Cells(NewRow, 7).Value = ThisWorkbook.Sheets(1).Range("C11")
.Cells(NewRow, 8).Value = ThisWorkbook.Sheets(1).Range("I9")
.Cells(NewRow, 9).Value = ThisWorkbook.Sheets(1).Range("E11")
.Cells(NewRow, 10).Value = ThisWorkbook.Sheets(1).Range("G11")
.Cells(NewRow, 12).Value = ThisWorkbook.Sheets(1).Range("I11")
End With
'
MsgBox "Alta exitosa.", vbInformation, strTitulo
Limpiar = MsgBox("Deseas limpiar los campos de la captura?", vbYesNo, strTitulo)
If Limpiar = vbYes Then
With ActiveWorkbook.Sheets(1)
. Range("C6"). ClearContents
. Range("I6"). ClearContents
. Range("E6"). ClearContents
. Range("G6"). ClearContents
. Range("C9"). ClearContents
. Range("C11"). ClearContents
. Range("I9"). ClearContents
. Range("E11"). ClearContents
. Range("G11"). ClearContents
. Range("I11"). ClearContents
'ClearContents no funciona en celda combinada...
.Range("F15").Value = ""
End With
Else
End If
'
End Sub

Les envío imagen para mejor referencia.

Necesitaría que en la celda M8 (opción 3) se multiplique I8*K8.

0

Añade tu respuesta

Haz clic para o