Macro que busque datos determinados en una hoja los copie y los pegue en otra hoja

Con tu gran ayuda necesito una macro que busque un centro determinado se ubique en el resultado de total promedio y lo copie y pegue en la hoja 2 es importante destacar que la cantidad de tramite varían diariamente por tal motivo no puedo vincularlas con celdas fijas ya que al dia siguiente al tener un reporte con mas tramites de un centro el total de promedio cambia de celda

Ejemplo

Contenido de la hoja 1

Column a column b column c

Centro tramite puntaje

a a 5

B 2

Total"promedio" 3.5

b a 5

B 5

C 2
Total"promedio" 4

Contenido de la hoja 2

Column a column b

Centro total promedio

a 3.5

B 4

1 respuesta

Respuesta
1

Sigue las Instrucciones para un botón y ejecutar la macro
1. Abre tu libro de Excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Ahora para crear un botón, puedes hacer lo siguiente:
6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona Asignar macro / Selecciona: copiar_promedio
9. Aceptar.
10. Para ejecutarla dale click a la imagen.

Sub copiar_promedio()
'por.dam
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
h1.Select
respuesta = MsgBox("Seleccona una opción" & vbCr & vbCr & _
    "Copiar un centro determinado <Si>, Copiar todos los centros <No>, Cancelar <Cancelar>", _
    vbYesNoCancel + vbQuestion, "Centros y promedios")
If respuesta = vbCancel Then Exit Sub
If respuesta = vbYes Then
    centro = InputBox("Centro determinado: ", "Centros y promedios")
    If centro = "" Then
        MsgBox "Sin centro a buscar", vbExclamation, "Centros y promedios"
        Exit Sub
    End If
    k = h2.Range("A" & Rows.Count).End(xlUp).Row
    Set buscado = h1.Range("A:A").Find(centro, MatchCase:=True)
    If centro <> buscado Then Set buscado = Nothing
    If Not buscado Is Nothing Then
        ini = buscado.Row
        fin = buscado.Row
    Else
        MsgBox "No se encontró el centro", vbCritical, "Centros y promedios"
        Exit Sub
    End If
Else
    ini = 2
    fin = h1.Range("A" & Rows.Count).End(xlUp).Row
    h2.Cells.Clear
    h2.Range("A1") = "Centro"
    h2.Range("B1") = "Total Promedio"
    k = 1
End If
For i = ini To fin
    If Trim(h1.Range("A" & i)) <> "" Then
        k = k + 1
        h2.Range("A" & k) = h1.Range("A" & i)
        For j = i To h1.Range("B" & Rows.Count).End(xlUp).Row
            If h1.Range("B" & j) <> "" Then
                If InStr(1, UCase(h1.Range("B" & j)), "PROMEDIO") > 0 Then
                    h2.Range("B" & k) = h1.Range("C" & j)
                    Exit For
                End If
            Else
                Exit For
            End If
        Next
    End If
Next
h2.Select
MsgBox "Fin de copiado de promedio", vbInformation, "Centros y promedios"
End Sub

Saludos.Dam
Si es lo que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas