Excel - Copiar rango entre hojas

 
Vista:

Copiar rango entre hojas

Publicado por Raziel (245 intervenciones) el 23/02/2010 20:03:01
A continuacion tengo un codigo que utilizo para copiar informacion de la hoja actual a la Hoja2 en la ultima celda seleccionada

ActiveCell.Copy
Sheets("Hoja2").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Entiendo que en muchos casos no necesito seleccionar los objetos para poder trabajar con ellos, se puede pegar en la hoja destino sin seleccionarla cada vez?
Saludos!
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Abraham Valencia
Val: 313
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

RE:Copiar rango entre hojas

Publicado por Abraham Valencia (2415 intervenciones) el 23/02/2010 22:00:33
ACtiveCell.Copy Destination := Sheets("Hoja2").Range("D4")

Abraham
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:Copiar rango entre hojas

Publicado por Raziel (245 intervenciones) el 24/02/2010 23:45:54
Hola Abraham, gracias por tu aporte, la pregunta era porque deseo depurar el codigo, tengo una serie de datos en distintas hojas con la misma configuracion de formato, algo asi...

A1=Destino1/Destino2/Destino3 (cambia con cada hoja)
De B1 a M1 Ene a Dic
A2=Real 2009
De A3 a A8 = Concepto1 a Concepto 6 respectivamente
De B3 a a M8 cantidades
A9=Presupuesto 2009
de A10 a A15 = Concepto1 a Concepto 6 respectivamente
De B10 a M15 cantidades

Y asi a lo largo de la hoja, a veces existen mas conceptos, a veces no existe presupuesto, etc

La cosa es que ya he creado la Macros que me permite volver todos esos datos en una base de datos con la que pretendo hacer graficos, etcetera, tengo que aclarar que aun la estoy depurando, pero ya hace su trabajo, anexo codigo:

Sub GENERABASEPRESUPUESTOS()
Dim intHojas As Integer
Dim varMeses As Variant
Dim varValores As Variant
Dim i As Integer

intHojas = Sheets.Count
Sheets("BASE").Select
Range("A3").Select
Application.ScreenUpdating = False
Range("A3").Resize(, 5).Value = Array("Destino", "Tipo de Dato", "Periodo", "Concepto", "Importe")
ActiveCell.Offset(1, 0).Select
For i = 1 To intHojas - 2
Sheets(i).Select
Range("A1").Select
Set varMeses = Range("$B$1:$M$1")
Do Until IsEmpty(ActiveCell.Value)
Select Case True
Case ActiveCell.Value = ActiveSheet.Name
ActiveCell.Copy
ActiveCell.Offset(1, 0).Select
Sheets("BASE").Select
ActiveCell.End(xlToLeft).Select
ActiveCell.End(xlToLeft).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Sheets(i).Select
Case InStr(ActiveCell.Value, "Real") Or InStr(ActiveCell.Value, "Presupuesto")
ActiveCell.Copy
ActiveCell.Offset(1, 0).Select
Sheets("BASE").Select
ActiveCell.End(xlToLeft).Select
ActiveCell.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Sheets(i).Select
Case ActiveCell.Value <> ActiveSheet.Name And Not InStr(ActiveCell.Value, "Real") And Not IsEmpty(ActiveCell.Value)
Set varValores = Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 12))
Selection.Copy
ActiveCell.Offset(1, 0).Select
Sheets("BASE").Select
ActiveCell.End(xlToLeft).Select
ActiveCell.End(xlToLeft).Select
ActiveCell.Offset(0, 3).Select
Range(ActiveCell, ActiveCell.Offset(11, 0)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Range(ActiveCell, ActiveCell.Offset(11)).Value = Application.WorksheetFunction.Transpose(varValores)
Set varValores = Nothing
ActiveCell.Offset(0, -2).Select
Range(ActiveCell, ActiveCell.Offset(11)).Value = Application.WorksheetFunction.Transpose(varMeses)
ActiveCell.End(xlDown).Select
ActiveCell.Offset(0, -1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
ActiveCell.End(xlDown).Select
ActiveCell.Offset(0, -1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
ActiveCell.End(xlDown).Offset(1, 3).Select
Sheets(i).Select
End Select
Loop
Set varMeses = Nothing
Next
Sheets("BASE").Select
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Despues de poner "Application.ScreenUpdating" la velocidad de ejecucion mejoro mucho, pero el seleccionar cada vez la distintas hojas para que funcione... se puede hagilizar por ese lado?
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar