Código VBA para un copiar y pegar
Con todos necesito que ayuden con esta pregunta necesito copiar los datos de mi hoja 1 y pegarlos en la hoja 2 dentro de una forma usando macro (conservar solo texto (t))
Les agradezco su ayuda y asesoría para solucionar dicho error.
Anexo para el código para su revisión.
Sub Copia_Datos()
'Codigo
Sheets("Hoja1").Select
Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Hoja2").Select
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 47")).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation _
:=xlNone, SkipBlanks:=False, Transpose:=False
'1° Elipse
Sheets("Hoja1").Select
Range("B1").Select
Selection.Copy
Sheets("Hoja2").Select
ActiveSheet.Shapes.Range(Array("Oval 48")).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation _
:=xlNone, SkipBlanks:=False, Transpose:=False
'2° Elipse
Sheets("Hoja1").Select
Range("C1").Select
Selection.Copy
Sheets("Hoja2").Select
ActiveSheet.Shapes.Range(Array("Oval 49")).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation _
:=xlNone, SkipBlanks:=False, Transpose:=False
'3° Elipse
Sheets("Hoja1").Select
Range("D1").Select
Selection.Copy
Sheets("Hoja2").Select
ActiveSheet.Shapes.Range(Array("Oval 52")).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation _
:=xlNone, SkipBlanks:=False, Transpose:=False
'4° Elipse
Sheets("Hoja1").Select
Range("E1").Select
Selection.Copy
Sheets("Hoja2").Select
ActiveSheet.Shapes.Range(Array("Oval 50")).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation _
:=xlNone, SkipBlanks:=False, Transpose:=False
'5° Elipse
Sheets("Hoja1").Select
Range("F1").Select
Selection.Copy
Sheets("Hoja2").Select
ActiveSheet.Shapes.Range(Array("Oval 51")).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation _
:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Respuesta de Dante Amor
4
Aquí otro código a considerar:
Sub Copia_Datos_2()
Dim sh1 As Worksheet
Set sh1 = Sheets("Hoja1")
With Sheets("Hoja2")
.DrawingObjects("Rounded Rectangle 47").Text = sh1.Range("A1")
.DrawingObjects("Oval 48").Text = sh1.Range("B1")
.DrawingObjects("Oval 49").Text = sh1.Range("C1")
.DrawingObjects("Oval 52").Text = sh1.Range("D1")
.DrawingObjects("Oval 50").Text = sh1.Range("E1")
.DrawingObjects("Oval 51").Text = sh1.Range("F1")
End With
End Sub
Muchas Gracias @Dante Amor también funciono correctamente
1 respuesta más de otro experto
Respuesta de Elsa Matilde
3
Te dejo el código ajustado para las 3 primeras formas, faltaría repetir las instrucciones para el resto ajustando el nombre de cada objeto.
Sub Copia_Datos()
'hoja con las formas
Sheets("Hoja2").Select
'Codigo
dato = Sheets("Hoja1").[A1]
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 47")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = dato
'1° Elipse
dato = Sheets("Hoja1").[B1]
ActiveSheet.Shapes.Range(Array("Oval 48")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = dato
'2° Elipse
dato = Sheets("Hoja1").[C1]
ActiveSheet.Shapes.Range(Array("Oval 49")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = dato
'el resto de las formas
'quitar la selección de las formas
[A1].Select 'opcional
End Sub
Sdos y no olvides valorar esta respuesta.