Tengo el siguiente macro que lo acomode a mi utilidad
Sub Copiar_a_RecKardex()
For Each Hoja In Worksheets
If Hoja.Name <> "REC" Then
'Comprobamos antes si la hoja está entre las mencionadas en la columna R
Dim qRangoR As Range
'Set qRangoR = Application.Intersect(Columns("P:P"), Hoja28.UsedRange)
Set Origen = Range("P2")
For Each cell In Origen
If cell.Value = Hoja.Name Then
'si la hoja coincide con alguno de los nombres de la columna N, se ejecuta
uFila = Worksheets("REC").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("REC").Range("b3:O" & uFila).Copy Destination:=Worksheets(Hoja.Name).Range("A" & Rows.Count).End(xlUp).Offset(1)
Else
'si no coincide no hace nada
End If
Next cell
End If
Next
End Sub
Bueno como les indique hace lo que necesito, pero que código tendria que aumentar para pasar el rango seleccionado de mi hoja TKT a otro libro que esta con el nombre "CUENTAS" ???
Saludos cordiales
Jesús
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Buenas noches:
Tengo el siguiente macro que lo acomode a mi utilidad
Sub Copiar_a_RecKardex() For Each Hoja In Worksheets If Hoja.Name <> "REC" Then 'Comprobamos antes si la hoja está entre las mencionadas en la columna R Dim qRangoR As Range 'Set qRangoR = Application.Intersect(Columns("P:P"), Hoja28.UsedRange) Set Origen = Range("P2") For Each cell In Origen If cell.Value = Hoja.Name Then 'si la hoja coincide con alguno de los nombres de la columna N, se ejecuta uFila = Worksheets("REC").Range("A" & Rows.Count).End(xlUp).Row Worksheets("REC").Range("b3:O" & uFila).Copy Destination:=Worksheets(Hoja.Name).Range("A" & Rows.Count).End(xlUp).Offset(1) Else 'si no coincide no hace nada End If Next cell End If Next End Sub
Bueno como les indique hace lo que necesito, pero que código tendria que aumentar para pasar el rango seleccionado de mi hoja TKT a otro libro que esta con el nombre "CUENTAS" ???
Saludos cordiales
Jesús