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 respuesta
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 ' : )
