Seleccionar y Copiar Rango de Celdas a otra Hoja
Tengo una base en Excel con la cual estoy preparando una macro en la que necesito copiar un rango de celdas hacia otra hoja según la columna G "CTAORIGEN", mencionar que la base ya está ordenada según la columna G.
Actualmente tengo la siguiente macro, pero se me vuelve muy lento el proceso ya que la base es un poco grande, y como ves tiene que ir fila por fila copiando a la otra hoja.
Queria saber si habria otra forma de poder seleccionar todo el rango de celdas que cumplan el criterio y copiarlo todo de una sola vez en la hoja correspondiente.
Todos los que en la columna G tengan 011111111111 copiar en la hoja COF1 y todos los que tengan 022222222222 copiar en la hoja COF2.
j = 1
Set Sht3 = Sheets("Resultado")
Set Sht6 = Sheets("COF1")
Set Sht5 = Sheets("COF2")
Uf2 = Sht3.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Uf2
If LCase(Sht3.Cells(i, "G")) = LCase("011111111111") Then
Sht3.Range("A" & i & ":F" & i).Copy
Sht6.Range("A" & j).PasteSpecial xlPasteValues
j = j + 1
Else
Sht3.Range("A" & i & ":F" & i).Copy
Sht5.Range("A" & j).PasteSpecial xlPasteValues
j = j + 1
End If
Next
2 respuestas
Antes de ejecutar la macro, revisa que en las hojas "COF1" y "COF2" la columna "G" tenga formato "Texto", de esa forma se conservarán los ceros a la izquierda de los números.
Prueba lo siguiente.
Sub copiarFilas()
Dim Sht3 As Worksheet
Dim a As Variant, b As Variant, c As Variant
Dim i As Long, j As Long, k As Long, n As Long
'
Set Sht3 = Sheets("Resultado")
a = Sht3.Range("A2:G" & Sht3.Range("A" & Rows.Count).End(xlUp).Row).Value2
ReDim b(1 To UBound(a), 1 To 7)
ReDim c(1 To UBound(a), 1 To 7)
'
For i = 1 To UBound(a, 1)
Select Case a(i, 7)
Case "011111111111"
j = j + 1
For n = 1 To 7
b(j, n) = a(i, n)
Next
Case "022222222222"
k = k + 1
For n = 1 To 7
c(k, n) = a(i, n)
Next
End Select
Next
Sheets("COF1").Range("A2").Resize(j, 7).Value = b
Sheets("COF2").Range("A2").Resize(k, 7).Value = c
End Sub
¡Gracias! Dante Amor, me funciono perfecto
¿Mejoró el tiempo?
Me alegra ayudarte, g racias por comentar.
Esto puede sumar algo más a lo dicho:
https://www.youtube.com/watch?v=nPSFAZ8TvrQ&list=PLdK9H5dMIfQhn9waYbEdu3DYAuBdSCIBx