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.

1 Respuesta

Respuesta
1

No pusiste esta función EPMAddInAutomation, así que no puedo probar tu macro.

Le hice algunos cambios a tu macro:

Sub Copiar1()
'
' 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() 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))
    ini = RangoValores.Cells(1, 1)
    fin = RangoValores.Rows.Count + ini
    offset_fin = offset_ini + fin
    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
            ReDim Preserve Staticarray(i)
            Staticarray(i) = valor_Num
            i = i + 1
            ActiveSheet.Cells(fila, columna + offset_ini).Select
            Range(Cells(fila, columna + offset_ini), Cells(fila, columna + offset_fin)).Value = Staticarray()
        cell.Value = ""
        Next
    End If
    '
    Application.Cursor = WnCursor
    Application.Interactive = True
    Application.ScreenUpdating = True
    ActiveSheet.Protect
End Sub

Prueba y me comentas si te funciona, de lo contrario, mejor explícame qué necesitas con un ejemplo y te creo una nueva macro.

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Hola Dante,

La macro que me colocas no me ha funcionado porque me dice que el next no tiene un for. Efectivamente veo que tienes el for each arriba pero no se porque el next no lo reconoce como parte de ese for.

De cualquier forma te explico lo que quiero hacer. Tengo una columna que se llama valor en la columna A y en la columna A escribo valores por ejemplo un 10 en el A3. Entonces quiero que ese valor se copie a partir de la celda C3 en adelante (D3,D4,D5.....). Antes era facil porque solo tenia que copiarlo 24 veces  porque eran solo dos años (24 meses) pero ahora ha cambiado y pueden ser 3 años (36 meses) o solo un año (12 meses) por eso necesito que ahora la copia sea dinamica y no he conseguido hacela.

Gracias por tu ayuda 

Ah se me olvidaba así como escriben el valor en A3 por ejemplo, luego escriben en A4, A5 y esos valores también se tienen que copiar en D4, C4...

Vale añado más información. He podido probar tu macro, lo que le faltaba era un end if por lo que veo, pero no me ha funcionado. Porque no me copia el valor hasta la ultima celda que quiero si no que se pasa :(

Sabía que era algo más simple.

Supongo que tienes encabezados en la fila 2.

Entonces, la macro debe copiar lo que tienes en la columna A, desde A3 hasta An (la última fila con datos) y pegarlos desde C3 hasta la última columna con datos y hasta la última fila con datos.

Prueba con lo siguiente:

Sub Copiar_Celdas()
'Por.Dante Amor
    uf = Range("A" & Rows.Count).End(xlUp).Row
    uc = Cells(2, Columns.Count).End(xlToLeft).Column
    Range("A3:A" & uf).Copy Range("C3", Cells(uf, uc))
End Sub

Si no es lo que necesitas, entonces , pon unas imágenes de lo que tienes y otra imagen con lo que esperas de resultado.

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Hola Dante, la macro no me ha funcionado.

Te dejo con dos imágenes lo que quiero hacer.

En la primera imagen puedes que esta la columna valor, luego una columna en blanco, y luego las columnas con los meses. Entonces en la columna valor el usuario va a introducir el 10 por ejemplo.

Luego al ejecutar la macro ese 10 se tiene que copiar pero a partir de la columna amarilla, es decir, en la columna que dice total año no quiero que se copie el valor porque allí tengo un promedio.

Entonces en la primera columna pueden introducir un 10, luego en la segunda un 20 y así por lo que la macro tiene que recorrerse toda la hoja imagino hasta ver que ha copiado todos los datos.

Como te comentaba antes era fácil porque solo se requería copiar dos años y se hacia el for hasta el 24, pero ahora tiene que ser dinámico.

Si tienes alguna duda por favor coméntamelo y gracias por tu ayuda

Sí tengo dudas. Primero habías dicho que capturabas el valor en la celda A3, pero ahora ya no sé en cuál columna.

Desafortunadamente tus imágenes no tienen las filas y las columnas, entonces no sé en cuál columna está la columna valor y en cuál columna está el mes-año ene-2023

Mi macro suponía que la columna valor era la columna A y que tus datos empiezan en la fila 2

Como tampoco se ven las filas en la imagen, tampoco puedo arreglar la macro.

Pero es muy fácil, esta es mi macro:

Sub Copiar_Celdas()
'Por.Dante Amor
    uf = Range("A" & Rows.Count).End(xlUp).Row
    uc = Cells(2, Columns.Count).End(xlToLeft).Column
    Range("A3:A" & uf).Copy Range("C3", Cells(uf, uc))
End Sub

Suponiendo que la columna valor es la "C", y el mes empieza en la D, entonces quedaría así:

Sub Copiar_Celdas()
'Por.Dante Amor
    uf = Range("C" & Rows.Count).End(xlUp).Row
    uc = Cells(2, Columns.Count).End(xlToLeft).Column
    Range("C3:C" & uf).Copy Range("E3", Cells(uf, uc))
End Sub

Pero también es importante que me digas en qué fila están los encabezados, yo puse el 2 y que los valores empiezan en la 3, pero si los encabezados están en la 10, entonces sería así:

Sub Copiar_Celdas()
'Por.Dante Amor
    uf = Range("A" & Rows.Count).End(xlUp).Row
    uc = Cells(10, Columns.Count).End(xlToLeft).Column
    Range("A11:A" & uf).Copy Range("C11", Cells(uf, uc))
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Hola Dante. Tienes Razon.

El encabezado valor esta en A2 y los datos comienzan en A3, pero el dato se tiene que copiar a partir de ene2023, y eso esta en C2 el encabezado y el dato comienza en C3.

Entonces el usuario ira escribiendo valores en A3, A4, A5 y se tienen que ir copiando en C3, C4, C5... es decir tiene que hacer un "salto" el copiar porque en la columna B no hay nada

Gracias 

Según tu imagen las filas y las columnas parecen ser otras.

Mejor envíame tu archivo, con 2 hojas, en la hoja1, me pones un ejemplo antes de la copia, y en la hoja2 me pones el mismo ejemplo pero después de la copia

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Montserrat Mavarez” y el título de esta pregunta.

Hola Dante. Gracias por tu ayuda.

El archivo te lo envío hasta el domingo porque estoy fuera de casa por trabajo precisamente.

Gracias de nuevo

No te preocupes, cuando tengas tiempo. Sal  u dos

Hola Dante, ya te envíe la información a tu correo.

Gracias por tu ayuda

Según tu archivo, y te pongo una imagen,

En la fila 4 van los encabezados

En la columna A van los países

En la columna B van los valores

En la columna D empiezan los meses

Si en tu archivo cambias alguno de estos datos, entonces hay que ajustar la macro.

No importa cuantas filas hay en los países, no importa cuántos meses hay en la fila 4, la siguiente macro resuelve si hay 5 países o si hay 200 países; o si hay 2 meses o 50 meses.

Sub Copiar_Celdas()
'Por.Dante Amor
    uf = Range("A" & Rows.Count).End(xlUp).Row          'en la columna A están los países
    uc = Cells(4, Columns.Count).End(xlToLeft).Column   'en la fila 4 están los encabezados
    Range("B5:B" & uf).Copy Range("D5", Cells(uf, uc))  'en la columna B están los valores y se pegan de la D en adelante
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas