Macro que busque valores en varias hojas y que los datos los presente creando una columna en otra hoja

Necesito ayuda lo que quiero hacer es que de una lista de nombres cada uno de los empleados se busque en la hojas sem-1, sem-2 y asi sucesivamente, es decir que busque a los empleados en las siguientes hojas y me indique el numero de la maquinaria que esta en la fila H en el cual trabajo durante cada semana. Si fuera posible que automáticamente se genere el nombre sem-1 sem-2 ... Y que comience a buscar y llenar datos.

1 Respuesta

Respuesta
1

La última macro que me enviaste ya toma la máquina de la columna "H", explícame cuál es el problema.

Sub Semanas()
'Por.Dante Amor
    Set h1 = ActiveSheet
    h1.Range("D2:CX5000").ClearContents
    '
    c = 2
    For Each h In Sheets
        If UCase(Left(h.Name, 3)) = "SEM" Then
            uc = h1.Cells(1, Columns.Count).End(xlToLeft).Column + 1
            h1.Cells(1, uc) = h.Name
            '
            For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
                Set b = h.Cells.Find(h1.Cells(i, "A"), LookAt:=xlPart)
                If Not b Is Nothing Then
                    maq = h.Cells(b.Row, "H")
                    h1.Cells(i, c) = maq
                    a = a
                End If
            Next
            c = c + 1
        End If
    Next
    MsgBox "Buscar nombres en las semanas", vbInformation, "TERMINADO"
End Sub

Lo que sucede es que no se porque no corre la macro se queda parada por fis ayúdame revisando cual puede ser la causa de que no funcione la macro ya te envie la mail el archivo gracias

Listo. Te envié la macro actualizada

Sub Semanas()
'Por.Dante Amor
    Set h1 = ActiveSheet
    h1.Range("B1:CX5000").ClearContents
    '
    c = 2
    For Each h In Sheets
        If UCase(Left(h.Name, 3)) = "SEM" Then
            uc = h1.Cells(1, Columns.Count).End(xlToLeft).Column + 1
            h1.Cells(1, uc) = h.Name
            '
            For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
                Set b = h.Cells.Find(h1.Cells(i, "A"), LookAt:=xlPart)
                If Not b Is Nothing Then
                    maq = h.Cells(b.Row, "H")
                    h1.Cells(i, c) = maq
                    a = a
                End If
            Next
            c = c + 1
        End If
    Next
    MsgBox "Buscar nombres en las semanas", vbInformation, "TERMINADO"
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas