Macro que copie valor celda en rangos distintos y elimine filas vacías (adjunto ejemplo)
Tiene que copiar el valor de una celda de la columna A
Copiar este valor en un rango que es variable en la misma columna
Y eliminar todas las filas vacías.
Los registros pueden oscilar entre 30.000 y 40.000
Si alguien me dice como puedo poneros una hoja excel de muestra para que sea más entendible la petición, os la pongo.
1 Respuesta
Hola Elsa, aquí en Madrid (España), buenos días
Te adjunto imágenes del ejemplo
Si lo prefieres, dime un correo donde te pueda enviar el fichero excel para que lo puedas ver mejor (sigo sin ver opción de adjuntar aqui el fi
Se trata de copiar el número de la cuenta contable, y ponerlo en todos los apuntes contables.
Después debe eliminar todas las filas vacías.
Todo se desarrolla en la columna A:A
Tengo ya hecha una macro pero me falla
a la mitad del proceso, no copia bien la cuenta y no soy capaz de ver el porqué.
Envíame el libro con la macro a cibersoft.arg de gmail.com
Sdos!
Esta es la macro reducida y simplificada:
Sub hojaFormatos()
'Elsamatilde
Dim filx As Long
Dim ctax As String
'se limpia la hoja Formatos (opcional)
Sheets("Formatos Balances Semestrales R").Select
Application.ScreenUpdating = False
ActiveSheet.UsedRange.Clear
Range("A1").Select
'copia la hoja Origen pegandola en esta hoja
Sheets("Origen datos").Select
ActiveSheet.UsedRange.Copy _
Destination:=Sheets("Formatos Balances Semestrales R").Range("A1")
'empieza a trabajar en hoja Formatos, eliminando las 1ras 7 filas
Sheets("Formatos Balances Semestrales R").Select
Rows("1:7").Delete Shift:=xlUp
'se guarda la última fila del rango que lo da la col H (opcional)
filx = Range("H" & Rows.Count).End(xlUp).Row
'elimina las vacías en C y las que dicen Suma....en B
Range("C1").Select
While ActiveCell.Row <= filx
If ActiveCell = "" Or Left(ActiveCell.Offset(0, -1), 4) = "Suma" Then
ActiveCell.EntireRow.Delete
'resto 1 al fin de rango
filx = filx - 1
'sino pasa a la fila sgte
Else
If Range("A" & ActiveCell.Row) <> "" Then
ctax = Range("A" & ActiveCell.Row)
Else
Range("A" & ActiveCell.Row) = ctax
End If
ActiveCell.Offset(1, 0).Select
End If
Wend
MsgBox "Fin del formato"
End SubSdos!
