Un detalle con lenguaje VBA sobre un rango
En un libro de excel, dentro de una de sus hojas, tengo una macro programada para que me pegue siempre el mismo rango. El código es el siguiente:
Sub CopiaRango()
Set celdas = Range("Rango")
fini = celdas.Cells(1, 1).Row
ffin = fini + celdas.Rows.Count - 1
filas = celdas.Rows.Count
cini = celdas.Cells(1, 1).Column
cfin = cini + celdas.Columns.Count - 1
'
u = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For i = ffin + 3 To u + filas + 3 Step filas + 2
Set destino = Range(Cells(i, cini), Cells(i + filas - 1, cfin))
contara = Application.CountA(destino)
If contara = 0 Then
celdas.Copy destino
Exit For
End If
Next
MsgBox "Rango de celdas copiado", vbInformation
Luego, para que me traslade la información contenida en una de las celdas del rango que se va copiando una y otra vez, a una base de datos que se va nutriendo de dicha información de dicha celda, he intentado este código:
Sub Traspaso()
'
' Traspaso Macro
'
'
Range("Rango").Select
ActiveCell.Offset(2, 1).Select
Selection.Copy
Sheets("Análisis").Select
Range("B6").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Escandallaje").Select
Range("C6").Select
End Sub
Y sale bien, salvo por un detalle: me copia siempre la información contenida en la celda del rango original. Y yo quisiera que fuera a la celda de cada rango que se copia donde está dicha información (esa celda siempre está en el mismo lugar dentro del rango que se copia: 2ª fila y 2ª columna), y la pegue en la base de datos. ¿Qué puedo hacer para que eso ocurra?
H o l a:
Entiendo que copias un "rango" hacia una filas abajo.
Lo que quieres es copiar una celda de ese "rango" a la hoja "Análisis"
Si quieres que se copie la misma información, entonces tendrías que hacerlo de forma secuencial, es decir, primero copias el rango y luego la celda:
Sub CopiaRango()
Set celdas = Range("Rango")
fini = celdas.Cells(1, 1).Row
ffin = fini + celdas.Rows.Count - 1
filas = celdas.Rows.Count
cini = celdas.Cells(1, 1).Column
cfin = cini + celdas.Columns.Count - 1
'
u = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For i = ffin + 3 To u + filas + 3 Step filas + 2
Set destino = Range(Cells(i, cini), Cells(i + filas - 1, cfin))
contara = Application.CountA(destino)
If contara = 0 Then
celdas.Copy destino
Exit For
End If
Next
'
'En esta parte se copia la celda
call Traspaso
'
MsgBox "Rango de celdas copiado", vbInformation
End SubEstoy agregando en la primera macro la llamada a la macro "Traspaso", de esa forma cada vez que copies el rango, se llevará a la hoja análisis la celda que se copió.
Revísalo y me comentas.
