Estoy necesitando una macro que me busque datos en varias hojas y me traiga resultados.
tengo esta macro pero me salen errores en dos lineas favor ayudarme a corregirlas:
Option Explicit
'cambiale el nombre el nombre a la cte. Por el real de la hoja índice
Global Const indice = "comp_ctas"
Sub general()
'cambiale por el número máximo de códigos
Const códigos = 200 'Ojo importante el siguiente paso!!!!
'cambiale el nombre a la PRIMERA CELDA (no confundir con la de búsqueda)
'que contiene códigos en índice
Const cod = "B8"
Dim inf As Variant, sup As Variant
Dim f As Long
Application.ScreenUpdating = False
'me posiciono en la hoja índice
Sheets(indice).Select
'la coloco en la primera posición si no lo está
If Sheets(1).Name <> ActiveSheet.Name Then
Sheets(indice).Move before:=Sheets(1)
End If
'me posiciono en la primera celda con códigos
Range(cod).Select
'asigno inicialmente la variable a la posición
f = ActiveCell.Row
'pregunto por la cota inferior de búsqueda de los códigos
inferior:
inf = Application.InputBox("Introduzca la posición de la cota inferior de búsqueda de los códigos." & vbCrLf & "Mínimo " & f & ", Máximo " & códigos & ". Cancelar ó 0 para salir.")
If IsNumeric(inf) = False Then
MsgBox "El valor introducido no es un número. Vuelva a intentarlo.", vbOKOnly + vbExclamation
GoTo inferior
ElseIf inf - Int(Abs(inf)) <> 0 Then
MsgBox "El valor introducido no es un número entero positivo. Vuelva a intentarlo.", vbOKOnly + vbExclamation
GoTo inferior
End If
inf = CDbl(inf)
Select Case inf
Case Is = False:
Exit Sub
Case Is = "":
MsgBox "No ha introducido ningún valor. Vuelva a intentarlo.", vbOKOnly + vbExclamation GoTo inferior
Case Is > códigos:
MsgBox "El valor introducido es mayor al permitido. Vuelva a intentarlo.", vbOKOnly + vbExclamation GoTo inferior
Case Is < f:
MsgBox "El valor elegido no contiene códigos. Imposible continuar.", vbOKOnly + vbExclamation
Exit Sub
End Select
superior:
sup = Application.InputBox("Introduzca la posición de la cota superior de búsqueda de los códigos." & vbCrLf & "Mínimo " & inf + 1 & ", Máximo " & códigos & ". Cancelar ó 0 para salir.")
If IsNumeric(sup) = False Then
MsgBox "El valor introducido no es un número. Vuelva a intentarlo.", vbOKOnly + vbExclamation
GoTo superior
ElseIf sup - Int(Abs(sup)) <> 0 Then
MsgBox "El valor introducido no es un número entero positivo. Vuelva a intentarlo.", vbOKOnly + vbExclamation
GoTo superior
End If
sup = CDbl(sup)
Select Case sup
Case Is = False:
Exit Sub
Case Is = "":
MsgBox "No ha introducido ningún valor. Vuelva a intentarlo.", vbOKOnly + vbExclamation GoTo superior
Case Is > códigos:
MsgBox "El valor introducido es mayor al permitido. Vuelva a intentarlo.", vbOKOnly + vbExclamation
GoTo superior
Case Is MsgBox "La cota inferior es igual o mayor a la superior. Vuelva a intentarlo", vbOKOnly + vbExclamation
GoTo superior
End Select
'teniendo las cotas, empiezo la búsqueda y relleno los datos con operar
Call operar(sup, inf)
End Sub
Sub operar(sup As Variant, inf As Variant)
'Ojo importante el siguiente paso!!!!
'cambiale el nombre a la PRIMERA CELDA que contiene códigos en LAS hojas de búsqueda 'es decir, si es B15 cambia B2 por B15
Const id_ini = "B15"
Dim i As Long, j As Long, k As Long, c As Long, f1 As Long, c1 As Long, id As Long
Dim DT As Single, FZ As Single
Dim hojas As Integer, cont As Integer, dif As Integer
Dim nom As String
Dim encontrado As Boolean
cont = 0
hojas = Worksheets.Count
c = ActiveCell.Column
For i = inf To sup
Sheets(indice).Select
id = Cells(i, c).Value
encontrado = False
For j = 2 To hojas
Sheets(j).Select
Range(id_ini).Select
f1 = ActiveCell.Row
c1 = ActiveCell.Column
k = 0
Do Until Cells(f1 + k, c1).Value = "" Or encontrado = True
If Cells(f1 + k, c1).Value = id Then
nom = ActiveSheet.Name
DT = Cells(f1 + k, 124).Value
FZ = Cells(f1 + k, 182).Value
encontrado = True
j = hojas
cont = cont + 1
Else: k = k + 1
End If
Loop
Next j
'si el código es encontrado, pego los valores en la hoja índice
If encontrado = True Then
Sheets(indice).Select
Cells(i, 5).Value = nom
Cells(i, 6).Value = DT
Cells(i, 7).Value = FZ
End If
Next i
'muestro balance final
Sheets(indice).Select
dif = sup - inf
Application.ScreenUpdating = True
Select Case cont
Case Is = 0
MsgBox "No se ha encontrado ningún código. Es posible que no existan o no se encuentren en el margen elegido.", vbOKOnly + vbInformation
Case Is = dif + 1
MsgBox "Se han encontrado todos los códigos: " & cont, vbOKOnly + vbInformation
Case Is < dif + 1
MsgBox "Se ha/n encontrado " & cont & " código/s de " & dif + 1 & " elegidos.", vbOKOnly + vbInformation
End Select
End Sub