Macro para borrar datos
Hola tengo esta macro que me han facilitado muy amablemente en todoexpertos
Sub ultimas4()
ufil = ActiveCell.SpecialCells(xlLastCell).Row
ucol = ActiveCell.SpecialCells(xlLastCell).Column
If ucol > 4 Then
Set A = Columns(ucol - 3)
Set b = Columns(ucol - 2)
Set c = Columns(ucol - 1)
Set d = Columns(ucol)
Union(A, b, c, d).Select
Union(A, b, c, d).Copy
Cells(1, ucol + 1).Select
ActiveSheet.Paste
Else
Columns("A:D").Copy
Cells(1, 5).Select
ActiveSheet.Paste
End If
End SubLo que me hace es buscar las ultimas cuatro columnas con datos y me las pega a continuación (a su derecha), hasta ahí todo perfecto
En la segunda columna de las cuatro que me pega, en la fila 5 hay una celda con el contenido MEDICIÓN MES.
Lo que necesito es que se borre todo lo que hay en esa columna por debajo de esa celda, después de haber pegado las cuatro columnas anteriores.
Eso cada vez que ejecute la macro anterior, osea copiar ultimas 4 columnas, pegarlas, borrar lo que hay en la segunda columna a partir de Medición Mes hacia abajo.
Muchísimas gracias, creo que me he explicado bien, sino es así intentaré mejorarlo.
1 Respuesta
Te mando la nueva macro.
'***Macro***
Sub ultimas4()
ucol = Cells(1, Columns.Count).End(xlToLeft).Column
ufil = ActiveCell.SpecialCells(xlLastCell).Row
'Por.Dam ucol = ActiveCell.SpecialCells(xlLastCell).Column
If ucol > 4 Then
Set A = Columns(ucol - 3)
Set b = Columns(ucol - 2)
Set c = Columns(ucol - 1)
Set d = Columns(ucol)
Union(A, b, c, d).Select
Union(A, b, c, d).Copy
Cells(1, ucol + 1).Select
ActiveSheet.Paste
If Cells(5, ucol + 2) = "MEDICIÓN MES" Then
Range(Cells(6, ucol + 2), Cells(ufil, ucol + 2)).Clear
End If
Else
Columns("A:D").Copy
Cells(1, 5).Select
ActiveSheet.Paste
End If
End Sub
'***Macro***
Hola, no me funciona, añado un enlace con un archivo de ejemplo.
https://skydrive.live.com/redir?resid=D71BDA07BC3FC017!126&authkey=!ABRPrRfqVx8vno4
Muchas gracias
No te funciona, porque en tu ejemplo, pusiste medición con acento y en la hoja está escrito sin acento.
Si quieres que siempre se borre esa parte, entonces pon la siguiente macro.
'***Macro***
Sub ultimas4()
ucol = Cells(1, Columns.Count).End(xlToLeft).Column
ufil = ActiveCell.SpecialCells(xlLastCell).Row
'Por.Dam ucol = ActiveCell.SpecialCells(xlLastCell).Column
If ucol > 4 Then
Set A = Columns(ucol - 3)
Set b = Columns(ucol - 2)
Set c = Columns(ucol - 1)
Set d = Columns(ucol)
Union(A, b, c, d).Select
Union(A, b, c, d).Copy
Cells(1, ucol + 1).Select
ActiveSheet.Paste
Range(Cells(6, ucol + 2), Cells(ufil, ucol + 2)).Clear
Else
Columns("A:D").Copy
Cells(1, 5).Select
ActiveSheet.Paste
End If
End Sub
'***Macro***saludos.dam
No olvides cerrar la pregunta
Cambia en la macro la palabra
Clear
Por
ClearContents
Saludos. Dam
No olvides cerrar la pregunta
