Código para copiar celdas discontinuas

08/10/2008 - 20:07 por Cecilia | Informe spam
Muy buenas tardes a todos, tengo una macro que entre otras cosas copia
celdas discontinuas y las pega en la fila superior, la tengo creada
así:

Private Sub CommandButton1_Click()
Range("C10").Select
Selection.Copy
Range("C9").Select
ActiveSheet.Paste
Range("G10").Select
Selection.Copy
Range("G9").Select
ActiveSheet.Paste
Range("I10").Select
Selection.Copy
Range("I9").Select
ActiveSheet.Paste
Range("K10").Select
Selection.Copy
Range("K9").Select
ActiveSheet.Paste
Range("O10:P10").Select
Selection.Copy
Range("O9:P9").Select
ActiveSheet.Paste
Range("A9").Select
Selection.EntireRow.Insert
Rows("10:10").Select
Selection.Copy
Rows("9:9").Select
Selection.PasteSpecial Paste:=xlPasteFormats
Range("A10").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
ComboBox1 = Empty
ComboBox2 = Empty
ComboBox1.SetFocus
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowFiltering:=True
Range("A9").Select
Sheets("MENU").Select
ActiveWorkbook.Save
End
End Sub

Y mi pregunta es ¿se puede reducir de alguna forma los códigos de
copiar/pegar en esta macro?
Muchísimas gracias por vuestra atención
Un saludo
Cecilia
 

Leer las respuestas

#1 Ivan
08/10/2008 - 22:14 | Informe spam
hola Cecilia,

Y mi pregunta es ¿se puede reducir de alguna forma los códigos de
copiar/pegar en esta macro?



una posibilidad podria ser algo asi (aunque no acabo de ver el sentido
a los copiados pegados, pero supongo que su motivo tendran) =>

Sub copiar()
Dim n As Byte, refs As Variant
refs = Array("c", "g", "i", "k", "o", "p")
For n = LBound(refs) To UBound(refs)
Range(refs(n) & 10).Copy Range(refs(n) & 9)
Next
Range("a9").EntireRow.Insert
Rows("10:10").Copy
Rows("9:9").PasteSpecial xlPasteFormats
Rows("9:9").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

es solo para lo que se refiere a los copiados/pegados que comentas,
para el resto creo que faltarian detalles, aunque puedes añadirlo
detras (seguro que te presentan formas mas sencillas)

en el boton podrias dejar algo asi [de momento]

Private Sub CommandButton1_Click()
copiar
TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
ComboBox1 = Empty
ComboBox2 = Empty
ComboBox1.Activate
Range(Cells(1, 9), Cells.SpecialCells(xlLastCell)).Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True, AllowFiltering:=True
Range("A9").Select
Sheets("MENU").Select
ActiveWorkbook.Save
End Sub

a la espera de otras posibilidades (y quizas algun dato mas) espero te
ayude

un saludo
Ivan

Preguntas similares