copiar y pegar disconituado

19/07/2004 - 18:09 por negrito ka | Informe spam
HOla. Queria saber como realizar la siguiente accion en Excel XP

Por ejemplo: tengo los siguientes datos

A1= 1
B1= 2
C1= 3
D1= 4
E1= 5
F1= 6

Selecciono A1, B1 y D1, los copio y deseo pegarlos en otra hoja pero que
mantengan la disposicion de columnas.
De que forma puedo realizarlo.??


Gracias!!!!

Negrito ka
 

Leer las respuestas

#1 Fernando Gomez
19/07/2004 - 19:56 | Informe spam
Encontre este macro que probablemente hace lo que necesitas, los comandos de
copia y pasteado lo ejecuta el macro. pruebalo y veras


Fernando


Sub CopyMultipleSelection()
Dim SelAreas() As Range
Dim PasteRange As Range
Dim UpperLeft As Range
Dim NumAreas As Integer, i As Integer
Dim TopRow As Long, LeftCol As Integer
Dim RowOffset As Long, ColOffset As Integer
Dim NonEmptyCellCount As Integer

' Salir si el rango no se selecciona
If TypeName(Selection) <> "Range" Then
MsgBox "Selecciona el rango a ser copiado. Se permite seleccion
multiple."
Exit Sub
End If

' Guarda las areas como rango de objetos separados
NumAreas = Selection.Areas.Count
ReDim SelAreas(1 To NumAreas)
For i = 1 To NumAreas
Set SelAreas(i) = Selection.Areas(i)
Next

' Determinar la celda superior izquierda de la seleccion
TopRow = ActiveSheet.Rows.Count
LeftCol = ActiveSheet.Columns.Count
For i = 1 To NumAreas
If SelAreas(i).Row < TopRow Then TopRow = SelAreas(i).Row
If SelAreas(i).Column < LeftCol Then LeftCol = SelAreas(i).Column
Next
Set UpperLeft = Cells(TopRow, LeftCol)

' Toma la dirreccion a pastear
On Error Resume Next
Set PasteRange = Application.InputBox _
(Prompt:="Especifique la celda superior izquierda para pastear su
rango:", _
Title:="Copy Mutliple Selection", _
Type:=8)
On Error GoTo 0
' Salir si cancela
If TypeName(PasteRange) <> "Range" Then Exit Sub

' Asegurese que solo la celda superior izquierda se use
Set PasteRange = PasteRange.Range("A1")

' Chequear el rango a pastear para la informacion existente
NonEmptyCellCount = 0
For i = 1 To NumAreas
RowOffset = SelAreas(i).Row - TopRow
ColOffset = SelAreas(i).Column - LeftCol
NonEmptyCellCount = NonEmptyCellCount + _
Application.CountA(Range(PasteRange.Offset(RowOffset,
ColOffset), _
PasteRange.Offset(RowOffset + SelAreas(i).Rows.Count - 1, _
ColOffset + SelAreas(i).Columns.Count - 1)))
Next i

' Si el rango a pastar no esta vacio, advierta al usuario
If NonEmptyCellCount <> 0 Then _
If MsgBox("Sobreescribir informacion existente?", vbQuestion +
vbSiNo, _
"Copy Multiple Selection") <> vbSi Then Exit Sub

' Copiar y pastear cada area
For i = 1 To NumAreas
RowOffset = SelAreas(i).Row - TopRow
ColOffset = SelAreas(i).Column - LeftCol
SelAreas(i).Copy PasteRange.Offset(RowOffset, ColOffset)
Next i
End Sub


"negrito ka" wrote in message
news:
HOla. Queria saber como realizar la siguiente accion en Excel XP

Por ejemplo: tengo los siguientes datos

A1= 1
B1= 2
C1= 3
D1= 4
E1= 5
F1= 6

Selecciono A1, B1 y D1, los copio y deseo pegarlos en otra hoja pero que
mantengan la disposicion de columnas.
De que forma puedo realizarlo.??


Gracias!!!!

Negrito ka


Preguntas similares