Macro pa buscar nombre de hoja y traer valores de allí

Hola, estoy tratando de hacer una macro que me permita buscar por nombre de hojas y una vez encontrada la hoja deseada se pueda copiar alguno datos en otra hoja3. Me explico mejor, tengo un libro con 100 hojas, la primera hoja la utilizare para ingresar datos y ver los resultados. En las demás hojas tengo datos en un rango A8:A33.
Lo que trato de hacer es que en la primera hoja ingreso el nombre de otra hoja (ej:Volkswagen) en la celda A3 y al presionar el botón de buscar, se busque la hoja que tiene ese nombre como nombre una vez encontrada la hoja con ese nombre, copie los datos del rango mencionado (A8:A33) y me los copie en la hoja3 empezando a partir de la celda B3 para abajo, hasta allí llegue. Pero lo que necesito es, continuar este proceso debajo de la ultima celda utilizada por el proceso anterior.
Es decir, si la info traída de la hoja Volkswagen termino de copiar en la celda B30, yo necesito poner otro nombre (ej:Fiat) en la celda A31 y al presionar otro botón de buscar, se busque en la hoja de nombre Fiat y me copie los datos del rango menciono (A8:A33) y me los copie a partir de la celda B31; y así sucesivamente pero creo que con que me expliquen como continuarlo una vez me las voy a ingeniar.
He intentado combinar el botón pero no he podido.
Modulo
Sub BUSCAR(hoja As String)
On Error GoTo err
Sheets(hoja).Range("A8:a33").Copy
Sheets("hoja3").Range("b03").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("A5").Select
err: errores (err.Number)
End Sub
Sub errores(n As Integer)
If Len(n) = 0 Then Exit Sub
Select Case n
Case Is = 9
MsgBox "La hoja indicada no existe", vbCritical
Case Else
If err.Number > 0 Then MsgBox err.Number & " " & err.Description
End Select
End Sub
EVENTO CLICK DEL BOTON
Private Sub CommandButton1_Click()
BUSCAR ([a3])
End Sub
Espero me puedan ayudar con esto, de antemano muchas gracias!

1 Respuesta

Respuesta
1
Que te parece esta
Sub encuentra()
On Error Resume Next
Dim HOJA As String
HOJA = Sheets("hoja3").Range("a3").Value
Sheets(HOJA).Range("a8:a33").Copy
[a1000000].Select
Selection.End(xlUp).Select
ActiveCell.Offset(2, 0).Value = HOJA
ActiveCell.Offset(3, 0).Select
ActiveSheet.Paste
If ActiveCell.Value = "" Then
MsgBox " NO SE ENCUENTRA LA HOJA"
ActiveCell.Offset(-1, 0).Value = ""
End If
End Sub
Lo que hace es que va pegando los valores uno debajo del otro, si pones los de vlkswagen primero te los pone a partir de la cels a5 y te pone el nombre de la hoja como encabezado
Acá esta el archivo donde lo probé:
http://hotfile.com/dl/119779851/88db862/fiat.xlsm.html
Creo que eso es lo que necesitas,
No olvides puntuar la pregunta!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas