Copiar hasta la ultima celda activa
Tengo la siguiente macro
Sub Copiar()
'
' Copiar Macro
'
Dim zEPMexample As New EPMAddInAutomation
Dim informeactual_Str As String
Dim valor_Num As Double
Dim offset_ini As Byte
Dim offset_fin
Dim offset As Byte
Dim columna As Byte
Dim fila As Byte
Dim celda As Range
Dim celdaInferiorDerecha_Str As String
Dim celdaSuperiorIzquierda_Str As String
Dim celdaInferiorDerecha As Range
Dim celdaSuperiorIzquierda As Range
Dim RangoValores As Range
Dim miemlocal_Txt As String
Dim final As Byte
Dim rep1 As Double
Dim rep2 As Double
Dim Staticarray(1 To 24) As Double
Dim I As Double
WnCursor = Application.Cursor
Application.Interactive = False
Application.ScreenUpdating = False
Application.Cursor = xlWait
ActiveSheet.Unprotect
'With Application
' .ScreenUpdating = False
'End With
If ActiveSheet.name = "Bases Centralizadas" Then
offset_ini = 3
Else
offset_ini = 3
End If
offset_fin = offset_ini + 23
'
' Buscamos la celda con el literal "valor" y seleccionamos la columna correspondiente
miemlocal_Txt = "= *EPMLocalMember(""Valor"",""*"",""*"")"
'valor_Num = ActiveCell.Value
' miemlocal_Txt = "= EPMLocalMember(""Valor"";""000"";""000"")"
'If ActiveCell.Value <> "" Then
informeactual_Str = zEPMexample.GetActiveReportName(ActiveSheet)
celdaSuperiorIzquierda_Str = zEPMexample.GetDataTopLeftCell(ActiveSheet, informeactual_Str)
celdaInferiorDerecha_Str = zEPMexample.GetDataBottomRightCell(ActiveSheet, informeactual_Str)
Set celdaSuperiorIzquierda = Range(celdaSuperiorIzquierda_Str)
Set celdaInferiorDerecha = Range(celdaInferiorDerecha_Str)
Set celda = Range(Cells(1, 1), Cells(65536, celdaInferiorDerecha.Column).End(xlUp)).Find(What:=miemlocal_Txt, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
Set RangoValores = Range(Cells(celdaSuperiorIzquierda.Row, celda.Column), Cells(celdaInferiorDerecha.Row, celda.Column))
If Not celda Is Nothing Then
For Each cell In RangoValores
If cell.Value <> "" And Application.IsNumber(cell.Value) Then 'And Cells(fila, celda.Column).Value <> 0 Then
fila = cell.Row
columna = cell.Column
valor_Num = cell.Value
For I = 1 To 24
Select Case I
Case 1 To 24
Staticarray(I) = valor_Num
End Select
Next
ActiveSheet.Cells(fila, columna + offset_ini).Select
Range(Cells(fila, columna + offset_ini), Cells(fila, columna + offset_fin)).Value = Staticarray()
End If
cell.Value = ""
Next
End If
Application.Cursor = WnCursor
Application.Interactive = True
Application.ScreenUpdating = True
ActiveSheet.Protect
End Sub
El problema es que en lugar de copiar hasta el 24 quiero que copie a la ultima celda activa ya que el rango es dinámico y no siempre acaba en el 24 que tiene el case.