Optimización de Macro copiar de excel

Para Dante Amor. Hola Dante cree esta macro y funciona parcialmente, quiero ver si me puedes ayudar a corregirla, quedo atento a tu respuesta para poder enviarte mi ejemplo muchas gracias por el apoyo y atención. La macro es la siguiente:

Private Sub Seleccionar()
Application.ScreenUpdating = False
Sheets("Índice").Activate
For i = 4 To 20000
Select Case Cells(i, "G")
Case "INFANTE"
Cells(i, "I"). Copy
Worksheets("INFANTE").Cells(i, "B"). PasteSpecial xlPasteValues
Case "NIÑO"
Cells(i, "I"). Copy
Worksheets("NIÑO").Cells(i, "B"). PasteSpecial xlPasteValues
Case "ADOLESCENTE"
Cells(i, "I"). Copy
Worksheets("ADOLESCENTE").Cells(i, "B"). PasteSpecial xlPasteValues
Case "ADULTO"
Cells(i, "I"). Copy
Worksheets("ADULTO").Cells(i, "B"). PasteSpecial xlPasteValues
Case "ANCIANO"
Cells(i, "I"). Copy
Worksheets("ANCIANO").Cells(i, "B"). PasteSpecial xlPasteValues
End Select
Next
Application.ScreenUpdating = True
End Sub

1

1 Respuesta

3.689.425 pts. Si me amas, siempre voy a estar en tu corazón; si me...

Sí, envíame tu archivo y me explicas con ejemplos lo que necesitas.

Recuerda poner en el asunto del correo tu nombre de usuario.

Te anexo la macro actualizada

Private Sub Seleccionar()
'Act.Por.Dante Amor
    Set h1 = ActiveSheet
    For i = 4 To h1.Range("I" & Rows.Count).End(xlUp).Row
        hoja = h1.Cells(i, "G")
        existe = False
        For Each h In Sheets
            If UCase(h.Name) = UCase(hoja) Then existe = True: Exit For
        Next
        If existe Then
            u = Sheets(hoja).Range("B" & Rows.Count).End(xlUp).Row + 1
            Sheets(hoja).Cells(u, "B") = h1.Cells(i, "I")
            h1.Cells(i, "J") = "Copiado"
        Else
            h1.Cells(i, "J") = "Hoja no existe"
        End If
    Next
    MsgBox "Fin"
End Sub

' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas