Buscar datos y copiarlos en otra hoja

A partir de la misma planilla quiero obtener un par de datos que encuentre según una búsqueda previa en la columna B de la hoja1 y traspasarlos a distintas filas y columnas de la hoja dos para enviarlos a un formato de certificado
tengo estas lineas de código
Sheets("rol no agricola").Visible = True
Sheets("rol no agricola").Select
Dim n As ReturnString
    x = InputBox("Introdusca el Rol", "Busca Rol y Dirección")
Set n = [B:B].Find(What:=x)
            If n Is Nothing Then
                  MsgBox "Ningún dato para este rol o rol no encontrado", vbInformation
            Else
                Range(n.Address).Select
                MsgBox "Aquí tienes la palabra " & UCase(x) & "."   'aca quiero agregar la instruccion de copiar en la hoja1 y pegar en la hoja2 
            End If
    Set n = Nothing
End Sub
Sheets("rol no agricola").Visible = TrueSheets("rol no agricola").SelectDim n As ReturnString
    x = InputBox("Introdusca el Rol", "Busca Rol y Dirección")    Set n = [B:B].Find(What:=x)                        'If n = "" Then                 '   MsgBox "Ningún dato para este rol o rol no encontrado", vbInformation                'End If            If n Is Nothing Then                  MsgBox "Ningún dato para este rol o rol no encontrado", vbInformation            Else                Range(n.Address).Select                MsgBox "Aquí tienes la palabra " & UCase(x) & "."            End If    Set n = NothingEnd Sub
¿El problema es que "n no toma el valor" me podrían ayudar?

1 Respuesta

Respuesta
1
Puedes probar con algo así
Sub busco_y_copio()
Dim n As Range
   Application.ScreenUpdating = False
    Sheets("rol no agricola").Visible = True
Sheets("rol no agricola").Select
    palabra_a_buscar = InputBox("Ingresar dato buscado", "Buscador")
    If palabra_a_buscar = "" Then Exit Sub
    Set n = [B:B].Find(what:=palabra_a_buscar)
    If n Is Nothing Then
        MsgBox "No he encontrado nada. Lo siento."
    Else
n.Select
        sino = MsgBox("¿Deseas copiar la columna?", vbYesNo, "Confirmar")
Sheets("rol no agricola").Visible = False
If sino = vbYes Then
Sheets("rol no agricola").Visible = True
Sheets("rol no agricola").Select
n.Select
Selection.Copy
    Sheets("Hoja2").Select
    Range("A1").Select 'pon aqui el rago que quieras
    ActiveSheet.Paste
    Application.CutCopyMode = False
Sheets("rol no agricola").Visible = False
Application.ScreenUpdating = True
End If
End If
End Sub
Pruébalas y ya me cuentas
Tengo lo siguiente
Sub BuscarR()
' BuscarR Macro
' Macro grabada el 07/05/2011 por Boris Olguin V
'
'
Sheets("rol no agricola").Visible = True
Sheets("rol no agricola").Select
Dim n As Range
    x = ""
    x = InputBox("Introdusca el Rol", "Busca Rol y Dirección", vbOKOnly) 'ver si mantener el imput o fabricarse un formulario
Set n = [a:a].Find(What:=x)
            If n = " " Then
            MsgBox "SIN DATOS", vbInformation
                Exit Sub
            End If
            If n Is Nothing Then
                  MsgBox "Ningún dato para este rol o rol no encontrado", vbInformation
            Else
                Range(n.Address, Selection.End(xlToLeft)).Select 'selecciono lo que encontró
                Selection.Copy          'lo copio
                num = n.Offset(0, 2)   'variable dire = lo que trae la busqueda pero al lado derecho un espacio
                dire = n.Offset(0, 3)    'variable dire = lo que trae la busqueda pero al lado derecho dos espacios
                lote = n.Offset(0, 4)
                localidad = n.Offset(0, 5)
                Sheets("Certificado De Numero").Select  'selecciono la hoja del certificado
                [R17].Value = n
                [H14].Value = num
                [AC17].Value = dire
                [N15].Value = lote
                [J17].Value = localidad
                Application.CutCopyMode = False
                MsgBox "certificado de numero generado rol " & UCase(x) & ".", vbInformation
            End If
    Set n = Nothing
    Application.ScreenUpdating = True
    Sheets("rol no agricola").Visible = False
End Sub
Sub BuscarR()
' BuscarR Macro' Macro grabada el 07/05/2011 por Boris Olguin V'
'Sheets("rol no agricola").Visible = TrueSheets("rol no agricola").SelectDim n As Range
    x = ""    x = InputBox("Introdusca el Rol", "Busca Rol y Dirección", vbOKOnly) 'ver si mantener el imput o fabricarse un formulario        Set n = [a:a].Find(What:=x)                    If n = " " Then            MsgBox "SIN DATOS", vbInformation                Exit Sub            End If            If n Is Nothing Then                  MsgBox "Ningún dato para este rol o rol no encontrado", vbInformation            Else                Range(n.Address, Selection.End(xlToLeft)).Select 'selecciono lo que encontró                Selection.Copy          'lo copio                num = n.Offset(0, 2)   'variable dire = lo que trae la busqueda pero al lado derecho un espacio                dire = n.Offset(0, 3)    'variable dire = lo que trae la busqueda pero al lado derecho dos espacios                lote = n.Offset(0, 4)                localidad = n.Offset(0, 5)                Sheets("Certificado De Numero").Select  'selecciono la hoja del certificado                                [R17].Value = n                [H14].Value = num                [AC17].Value = dire                [N15].Value = lote                [J17].Value = localidad                Application.CutCopyMode = False                                MsgBox "certificado de numero generado rol " & UCase(x) & ".", vbInformation            End If    Set n = Nothing    Application.ScreenUpdating = True    Sheets("rol no agricola").Visible = FalseEnd Sub
Guiándome por tu recomendación me figuró y me funciona bien, mi pregunta es como puedo validar la entrada de un dato nulo o del botón cancelar del imputbox, además quiero darle folio a cada certificado que se emite en la hoja dos pero no quiero que avance el folio cuando haya errores
De antemano gracias
Veamos si te entendí bien
A este código le agregue sino = MsgBox se sitúa en el dato y si lo confirmas te lo pasa y si eliges no no hará nada
Ademas te agregue esto si lo comfirmas te sumara uno en la celda A1 Range("A1"). Value = Range("A1"). Value + 1  cambiala por la que quieras
Sub BuscarR()
' Macro grabada el 07/05/2011 por Boris Olguin V
Sheets("rol no agricola").Visible = True
Sheets("rol no agricola").Select
Dim n As Range
    x = ""
    x = InputBox("Introdusca el Rol", "Busca Rol y Dirección", vbOKOnly) 'ver si mantener el imput o fabricarse un formulario
Set n = [a:a].Find(What:=x)
         If n = " " Then
            MsgBox "SIN DATOS", vbInformation
                Exit Sub
            End If
            If n Is Nothing Then
                  MsgBox "Ningún dato para este rol o rol no encontrado", vbInformation
            Else
               sino = MsgBox("¿Deseas copiar la columna?", vbYesNo, "Confirmar")
Sheets("rol no agricola").Visible = False
If sino = vbYes Then
                Range(n.Address, Selection.End(xlToLeft)).Select 'selecciono lo que encontró
                Selection.Copy          'lo copio
                num = n.Offset(0, 2)   'variable dire = lo que trae la busqueda pero al lado derecho un espacio
                dire = n.Offset(0, 3)    'variable dire = lo que trae la busqueda pero al lado derecho dos espacios
                lote = n.Offset(0, 4)
                localidad = n.Offset(0, 5)
                Sheets("Certificado De Numero").Select  'selecciono la hoja del certificado
                [R17].Value = n
                [H14].Value = num
                [AC17].Value = dire
                [N15].Value = lote
                [J17].Value = localidad
                Application.CutCopyMode = False
                Range("A1").Value = Range("A1").Value + 1
MsgBox "certificado de numero generado rol " & UCase(x) & ".", vbInformation
            End If
            End If
    Set n = Nothing
    Application.ScreenUpdating = True
    Sheets("rol no agricola").Visible = False
End Sub
Te puse en negrita las modificaciones
Ya me cuentas si te vale así
Lo ultimo y no te molesto y te punturé de lujo pues me has ayudado mucho
Tengo la hoja2 "Certificado" la que tiene un formato y en ella tiene un par de checkbox (1 y 2) que quiero "activar" cuando una de las celdas a copiar cumpla una condición ("U" o "R")
Tengo el siguiente código pero me requiere un objeto y no se como asociarlos
If ubi = "U" Then
                    CheckBox1.Value = True 
                Else
                    CheckBox2.Value = True
                End If
¿Debo realizar alguna acción en modo diseño?
Creo que lo que pides es algo así
If Range("A1") = "R" Then
CheckBox1.Value = 1
End If
If Range("A1") <> "R" Then
CheckBox1.Value = 0
End If
El valor 1 para los Checkbox es activado, y el 0 es desactivado
Al final tuve que hacer referencia a la página donde se encontraba el objeto (checkbox) hoja1. Objeto(casillas de verificación botones etc). value = 1 (true)
Gracias me haz introducido al mundo del macro como nunca lo esperé.
Francisco

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas