Copiar y pegar excel
Molestándote, otra vez. Pero en verdad tu ayuda me ha sido muy staisfactoria. Sucede lo siguiente:
consite en que tengo
Datos de la b14:u14 así sucesivamente para los renglones hasta b45:u45 cada renglón deseo copiarlo y pegarlo en un archivo que se llama "Regresión Panel Ingresos Propios (Prueba).xls" en la hoja "Panel" en la celda B2 (transpuesto por supuesto) al primer renglón que copie, el asociado a B14:u14, así el siguiente renglón que copie será el b15:u15 y este se pegara en el archivo y hoja referidos anteriormente pero ahora en la celda b22 (ya que al transponer el renglón se hizo columna y termino hasta el renglón b22). Este proceso se repite sucesivamente notándose que los renglones que se copian se pegan en el archivo y hoja mencionados anteriormente con la característica que el proceso que se sigue al pegarlos cambia de 20 renglones de diferencia para pegar. Es decir, el primero se pega en el archivo y hoja referidos anteriormente en la celda b2, el siguiente en el b22, el siguiente en el b42,..., y así sucesivamente hasta el b622.
Sé que me podrás ayudar, espero tu respuesta. De antemano gracias.
Bere, un abrazo
consite en que tengo
Datos de la b14:u14 así sucesivamente para los renglones hasta b45:u45 cada renglón deseo copiarlo y pegarlo en un archivo que se llama "Regresión Panel Ingresos Propios (Prueba).xls" en la hoja "Panel" en la celda B2 (transpuesto por supuesto) al primer renglón que copie, el asociado a B14:u14, así el siguiente renglón que copie será el b15:u15 y este se pegara en el archivo y hoja referidos anteriormente pero ahora en la celda b22 (ya que al transponer el renglón se hizo columna y termino hasta el renglón b22). Este proceso se repite sucesivamente notándose que los renglones que se copian se pegan en el archivo y hoja mencionados anteriormente con la característica que el proceso que se sigue al pegarlos cambia de 20 renglones de diferencia para pegar. Es decir, el primero se pega en el archivo y hoja referidos anteriormente en la celda b2, el siguiente en el b22, el siguiente en el b42,..., y así sucesivamente hasta el b622.
Sé que me podrás ayudar, espero tu respuesta. De antemano gracias.
Bere, un abrazo
2 Respuestas
Respuesta de valedor
1
Estoy suponiendo que las datos están en la Hoja1 y en donde se copiaran será la Hoja2, tu tarea es adaptarlo a tus necesidades, sino que tal si te me aburres...
Public Sub SeleccionarCopiar()
Dim co1 As Integer
Dim co2 As Integer
co2 = 2
For co1 = 14 To 45
Sheets("Hoja1").Select
Range(Cells(co1, 2), Cells(co1, 21)).Copy
Sheets("Hoja2").Select
Range("B" & Format(co2)).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, , True
co2 = co2 + 20
Next co1
Sheets("Hoja1").Select
End Sub
Public Sub SeleccionarCopiar()
Dim co1 As Integer
Dim co2 As Integer
co2 = 2
For co1 = 14 To 45
Sheets("Hoja1").Select
Range(Cells(co1, 2), Cells(co1, 21)).Copy
Sheets("Hoja2").Select
Range("B" & Format(co2)).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, , True
co2 = co2 + 20
Next co1
Sheets("Hoja1").Select
End Sub
Respuesta de fejoal
1
Primero disculpa la demora, pero tuve una semana "agitada"
OK, sobre la base de la macro proporcionada anteriormente, desarrollé la solución al problema que planteaste.
Ingresa en el archivo de origen -en un módulo nuevo- el siguiente código:
Sub TraspNext()
Dim FilAct As String
Dim CellRange As Range
Dim TestCell As Range
'BERE, puedes cambiar estos parámetros, si lo necesitas:
Destfile = "Regresión Panel Ingresos Propios (Prueba).xls"
Destsheet = "Panel"
Inicell = "B2"
Filas = 20
'==============================
Windows(Destfile).Activate
Sheets(Destsheet).Select
ActiveSheet.Range(Inicell).Select
ActiveWindow.ActivateNext
Cnt = 0
Set CellRange = Selection
For Each TestCell In CellRange
FilAct = Trim(Str(ActiveCell.Row))
FilAct = "B" + FilAct + ":U" + FilAct
Range(FilAct).Select
Selection.Copy
ActiveWindow.ActivateNext
Range(Inicell).Offset(Cnt * Filas).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
ActiveWindow.ActivateNext
Range(FilAct).Select
ActiveCell.Offset(1).Select
Cnt = Cnt + 1
Next TestCell
Set CellRange = Nothing
ActiveWindow.ActivateNext
ActiveSheet.Range(Inicell).Select
ActiveWindow.ActivateNext
MsgBox "Traspaso finalizado", vbInformation, "FIN MACRO"
End Sub
Al igual que el anterior, simplemente selecciona un rango de celdas desde la primera hasta la última linea a transferir al otro archivo (en tu caso podría ser: B14:B45)
Una vez seleccionada, dispara la macro TraspNext.
Importante: debes tener abiertos ambos archivos y sólo ellos dos.
Espero que esto te sirva pero, ya sabes, vuelve a preguntarme si no.
Un abrazo!
Fernando
OK, sobre la base de la macro proporcionada anteriormente, desarrollé la solución al problema que planteaste.
Ingresa en el archivo de origen -en un módulo nuevo- el siguiente código:
Sub TraspNext()
Dim FilAct As String
Dim CellRange As Range
Dim TestCell As Range
'BERE, puedes cambiar estos parámetros, si lo necesitas:
Destfile = "Regresión Panel Ingresos Propios (Prueba).xls"
Destsheet = "Panel"
Inicell = "B2"
Filas = 20
'==============================
Windows(Destfile).Activate
Sheets(Destsheet).Select
ActiveSheet.Range(Inicell).Select
ActiveWindow.ActivateNext
Cnt = 0
Set CellRange = Selection
For Each TestCell In CellRange
FilAct = Trim(Str(ActiveCell.Row))
FilAct = "B" + FilAct + ":U" + FilAct
Range(FilAct).Select
Selection.Copy
ActiveWindow.ActivateNext
Range(Inicell).Offset(Cnt * Filas).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
ActiveWindow.ActivateNext
Range(FilAct).Select
ActiveCell.Offset(1).Select
Cnt = Cnt + 1
Next TestCell
Set CellRange = Nothing
ActiveWindow.ActivateNext
ActiveSheet.Range(Inicell).Select
ActiveWindow.ActivateNext
MsgBox "Traspaso finalizado", vbInformation, "FIN MACRO"
End Sub
Al igual que el anterior, simplemente selecciona un rango de celdas desde la primera hasta la última linea a transferir al otro archivo (en tu caso podría ser: B14:B45)
Una vez seleccionada, dispara la macro TraspNext.
Importante: debes tener abiertos ambos archivos y sólo ellos dos.
Espero que esto te sirva pero, ya sabes, vuelve a preguntarme si no.
Un abrazo!
Fernando
Perdón pero hastaq ahorita acabo de checarlo. Lo tuve que hacer manualmente pero se que esto me será de gran ayuda para realizar cosas adelante. Gracias por ser tan lindo. Lo meteré y luego te comento ok. Como siempre eres super cortés