Guru do Excel e Power BI

Sub AleVBA_3328()
Dim Names As String
Dim cell
Dim sht As Worksheet
    With ThisWorkbook.Worksheets("Geral")
        For Each cell In .Range("B4", .Range("B4").End(xlDown))
            For Each sht In ThisWorkbook.Worksheets
                If sht.Name = cell.Value Then
                    sht.Activate
                    .Range("A" & cell.Row & ":F" & cell.Row).Copy
                    sht.Range("A" & sht.Rows.Count).End(xlUp).Offset(1, 0).Select
                    ActiveSheet.Paste
                End If
            Next sht
        Next cell
    End With
End Sub