Problema con loop de excell
Estoy trabajando en esta macro, lo que hace es pegar una lista de registro en otra hoja en forma horizontal, busca con un código la columna donde debe pegar los datos, y necesito intercalar una celda en blanco, hace todo lo que necesito, pero al terminarse la tabla dinámica o llegar al final de los registro me sale un error en la selección de copiado.
Private Sub CB_GPRE_Click()
Dim FILA As Object
Dim LINEA As Integer
VALOR_BUSCADO = Me.TXT_CODIGOPR
Set FILA = Sheets("DG").Range("B:B").Find(VALOR_BUSCADO, LOOKAT:=xlWhole)
LINEA = FILA.Row
'COJO RUBROS
Sheets("PRESUPUESTO").Select
Range("B14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'PEGO RUBROS
Sheets("DG").Select
Range("J" & LINEA).Select
'PEGO CON TRANSPONER
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'INICIO SALTOS
Sheets("DG").Select
ActiveCell.Select
Do While IsEmpty(ActiveCell.Offset(0, 1)) = False
If ActiveCell <> "" Then
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
ActiveCell.Offset(0, -1).Select
Selection.ClearContents
ActiveCell.Offset(0, 1).Select
Else
Exit Sub
End If
Loop
End Subcomo siempre les quedo muy agradecido.
Respuesta de Dante Amor
2
Prueba lo siguiente:
Private Sub CB_GPRE_Click()
Dim sh As Worksheet
Dim f As Range, c As Range
Dim col As Long
'
Application.ScreenUpdating = False
'
Set sh = Sheets("DG")
col = Columns("J").Column
'BUSCAR
Set f = sh.Range("B:B").Find(TXT_CODIGOPR, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
For Each c In Sheets("PRESUPUESTO").Range("B14", Sheets("PRESUPUESTO").Range("B14").End(4))
c.Copy
sh.Cells(f.Row, col).PasteSpecial xlPasteAll
col = col + 2
Next
End If
'
Application.ScreenUpdating = True
End Sub
¡Gracias!
Muchas gracias, como siempre tu respuesta acertada.
Eres reeeeebueno en programación. Gracias.
Encantado de ayudarte, gracias por comentar.
