Macros que busca registros y pega celdas

Hola amigos de todo experto muchas gracias por el servicio que prestan.
Les tengo una consulta tengo una macros que busca en la fila A de la hoja "TABLA GENERAL" en los primeras 3000 celdas si son iguales a las celdas D11, E11, F11 y G11 de la hoja "Hoja1" si la celda es igual a D11, E11, F11 y G11 de la "Hoja1" si encuentra por ejemplo que coincide la celda (A24) con D11 entonces copia la fila (BF24) si es la (A80) copia la celda (BF80) en la Hoja1 en la celda A80.
Cual es mi problema la rutina se demora mucho y no sé como hacer que se detenga antes de que llega a A3000, mi idea es la siguiente tiene que para si encuentra la coincidencia o encontrar una celda vacía y seguir con la siguiente rutina.
Espero su ayuda y muchas gracias de antemano. Dejo el código
Sub Copiar_Resultados()
For IncFi = 10 To 3000
Nfila = IncFi
Dim Comentario As String
Sheets("Hoja1").Select
Range("d11").Select
Nlaboratorio = Selection.Value
Sheets("TABLA GENERAL").Select
Range("a" & Nfila).Select
Comentario = Selection.Value
Sheets("TABLA GENERAL").Select
If Nlaboratorio = Comentario Then
Sheets("TABLA GENERAL").Select
Range("bf" & Nfila).Select
Selection.Copy
Sheets("Hoja1").Select
Range("A80").Select
ActiveSheet.Paste
End If
Sheets("Hoja1").Select
Range("e11").Select
Nlaboratorio = Selection.Value
Sheets("TABLA GENERAL").Select
Range("a" & Nfila).Select
Comentario = Selection.Value
Sheets("TABLA GENERAL").Select
If Nlaboratorio = Comentario Then
Sheets("TABLA GENERAL").Select
Range("bf" & Nfila).Select
Selection.Copy
Sheets("Hoja1").Select
Range("a79").Select
ActiveSheet.Paste
End If
Sheets("Hoja1").Select
Range("f11").Select
Nlaboratorio = Selection.Value
Sheets("TABLA GENERAL").Select
Range("a" & Nfila).Select
Comentario = Selection.Value
Sheets("TABLA GENERAL").Select
If Nlaboratorio = Comentario Then
Sheets("TABLA GENERAL").Select
Range("bf" & Nfila).Select
Selection.Copy
Sheets("Hoja1").Select
Range("a78").Select
ActiveSheet.Paste
End If
Sheets("Hoja1").Select
Range("g11").Select
Nlaboratorio = Selection.Value
Sheets("TABLA GENERAL").Select
Range("a" & Nfila).Select
Comentario = Selection.Value
Sheets("TABLA GENERAL").Select
If Nlaboratorio = Comentario Then
Sheets("TABLA GENERAL").Select
Range("bf" & Nfila).Select
Selection.Copy
Sheets("Hoja1").Select
Range("a77").Select
ActiveSheet.Paste
End If
Next
End Sub

1 respuesta

Respuesta
1
Como veo que maneas código puedo recomendarte:
En lugar de un for podrías usar, un hacer mientras la celda este vacía
Do While Not IsEmpty(ActiveCell)
Si no logras hacerlo sube un ejemplo de lo que quieres para tratar de ayudarte.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas