RE:Copiar rango entre hojas
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?