Macro que copie y pegue
Tengo dos hojas de calculo he confeccionado una macro que me copia los datos de la columna C Rango C3:C230 y me los pega en la segunda hoja en la columna A en el rango A3:A230 , mi problema es como hago para que la proxima vez que ejecute la macro en vez de pegar los datos en la columna A lo haga en la columna B y la siguiente en la C y asi sucesivamente.
1 respuesta
Respuesta
1
Podrias poner el codigo que estas usando en tu macro
ahi te pongo la macro
saludos
Sub pasaresumen()
'
' pasaresumen Macro
' Macro grabada el 09/06/2010 por Joaquín '
' Acceso directo: CTRL+r
'
Range("F3").Select
Selection.Copy
Windows("resumen pedidos.xls").Activate
Range("F2").Select
ActiveSheet.Paste
Windows("mi nueva plantilla.xls").Activate
Range("E8:E260").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollRow = 247
ActiveWindow.ScrollRow = 246
ActiveWindow.ScrollRow = 245
ActiveWindow.ScrollRow = 244
ActiveWindow.ScrollRow = 242
ActiveWindow.ScrollRow = 241
ActiveWindow.ScrollRow = 239
ActiveWindow.ScrollRow = 237
ActiveWindow.ScrollRow = 235
ActiveWindow.ScrollRow = 232
ActiveWindow.ScrollRow = 228
ActiveWindow.ScrollRow = 226
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 219
ActiveWindow.ScrollRow = 213
ActiveWindow.ScrollRow = 210
ActiveWindow.ScrollRow = 205
ActiveWindow.ScrollRow = 199
ActiveWindow.ScrollRow = 193
ActiveWindow.ScrollRow = 187
ActiveWindow.ScrollRow = 180
ActiveWindow.ScrollRow = 174
ActiveWindow.ScrollRow = 169
ActiveWindow.ScrollRow = 164
ActiveWindow.ScrollRow = 158
ActiveWindow.ScrollRow = 151
ActiveWindow.ScrollRow = 147
ActiveWindow.ScrollRow = 140
ActiveWindow.ScrollRow = 135
ActiveWindow.ScrollRow = 130
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 120
ActiveWindow.ScrollRow = 116
ActiveWindow.ScrollRow = 110
ActiveWindow.ScrollRow = 105
ActiveWindow.ScrollRow = 101
ActiveWindow.ScrollRow = 97
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 87
ActiveWindow.ScrollRow = 82
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 75
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 69
ActiveWindow.ScrollRow = 66
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 53
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
Windows("resumen pedidos.xls").Activate
Range("F5").Select
ActiveSheet.Paste
Range("G2").Select
Windows("mi nueva plantilla.xls").Activate
Range("H2").Select
saludos
Sub pasaresumen()
'
' pasaresumen Macro
' Macro grabada el 09/06/2010 por Joaquín '
' Acceso directo: CTRL+r
'
Range("F3").Select
Selection.Copy
Windows("resumen pedidos.xls").Activate
Range("F2").Select
ActiveSheet.Paste
Windows("mi nueva plantilla.xls").Activate
Range("E8:E260").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollRow = 247
ActiveWindow.ScrollRow = 246
ActiveWindow.ScrollRow = 245
ActiveWindow.ScrollRow = 244
ActiveWindow.ScrollRow = 242
ActiveWindow.ScrollRow = 241
ActiveWindow.ScrollRow = 239
ActiveWindow.ScrollRow = 237
ActiveWindow.ScrollRow = 235
ActiveWindow.ScrollRow = 232
ActiveWindow.ScrollRow = 228
ActiveWindow.ScrollRow = 226
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 219
ActiveWindow.ScrollRow = 213
ActiveWindow.ScrollRow = 210
ActiveWindow.ScrollRow = 205
ActiveWindow.ScrollRow = 199
ActiveWindow.ScrollRow = 193
ActiveWindow.ScrollRow = 187
ActiveWindow.ScrollRow = 180
ActiveWindow.ScrollRow = 174
ActiveWindow.ScrollRow = 169
ActiveWindow.ScrollRow = 164
ActiveWindow.ScrollRow = 158
ActiveWindow.ScrollRow = 151
ActiveWindow.ScrollRow = 147
ActiveWindow.ScrollRow = 140
ActiveWindow.ScrollRow = 135
ActiveWindow.ScrollRow = 130
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 120
ActiveWindow.ScrollRow = 116
ActiveWindow.ScrollRow = 110
ActiveWindow.ScrollRow = 105
ActiveWindow.ScrollRow = 101
ActiveWindow.ScrollRow = 97
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 87
ActiveWindow.ScrollRow = 82
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 75
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 69
ActiveWindow.ScrollRow = 66
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 53
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
Windows("resumen pedidos.xls").Activate
Range("F5").Select
ActiveSheet.Paste
Range("G2").Select
Windows("mi nueva plantilla.xls").Activate
Range("H2").Select
Disculpa la tardanza te propongo este script que te ayudara en lo que necesitas. En los comentarios esta la explicacion.
Sub copiar()
'Estas dos primeras lineas simplemente mejoran la velocidad de ejecucion del script
'y hacen que la ejecucion sea invisible para el usuario
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'con estas dos lineas seleccionamos la hoja y el rango a copiar
'en tu caso solo cambia en donde dice ("Hoja1") por el nombre de tu hoja origen
Sheets("Hoja1").Select
Range("C3:C230").Select
'con esta linea indicamos que copie la seleccion
Selection.Copy
'con estas dos lineas seleccionamos la hoja y el rango en donde se va a pegar
'en tu caso solo cambia en donde dice ("Hoja2") por el nombre de tu hoja destino
Sheets("Hoja2").Select
Range("A3").Select
'Ahora hacemos un if en el cual evaluamos si la celda A3 esta vacia
If ActiveCell.Text = "" Then
'si se cumple la condicion entonces pega la informacion en dicha celda (A3)
ActiveSheet.Paste
'sino
Else
'preguntamos si la celda que le sigue, en este caso B3 esta vacia
If ActiveCell.Offset(0, 1).Value = "" Then
'si se cumple la condicion entonces pega la informacion en dicha celda (B3)
ActiveCell.Offset(0, 1).Activate
ActiveSheet.Paste
Else
'sino entonces se corre hasta la ultima celda con datos + 1
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Activate
'y pega la informacion
ActiveSheet.Paste
End If
End If
Application.CutCopyMode = False
'activamos nuevamente la hoja 1
Sheets("Hoja1").Activate
'en la celda C3
Range("C3").Select
Application.Calculate
Application.ScreenUpdating = True
End Sub
Si esto resuelve el problema por favor comenta y cierra la pregunta, en caso contrario no dudes en preguntarme nuevamente.
Sub copiar()
'Estas dos primeras lineas simplemente mejoran la velocidad de ejecucion del script
'y hacen que la ejecucion sea invisible para el usuario
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'con estas dos lineas seleccionamos la hoja y el rango a copiar
'en tu caso solo cambia en donde dice ("Hoja1") por el nombre de tu hoja origen
Sheets("Hoja1").Select
Range("C3:C230").Select
'con esta linea indicamos que copie la seleccion
Selection.Copy
'con estas dos lineas seleccionamos la hoja y el rango en donde se va a pegar
'en tu caso solo cambia en donde dice ("Hoja2") por el nombre de tu hoja destino
Sheets("Hoja2").Select
Range("A3").Select
'Ahora hacemos un if en el cual evaluamos si la celda A3 esta vacia
If ActiveCell.Text = "" Then
'si se cumple la condicion entonces pega la informacion en dicha celda (A3)
ActiveSheet.Paste
'sino
Else
'preguntamos si la celda que le sigue, en este caso B3 esta vacia
If ActiveCell.Offset(0, 1).Value = "" Then
'si se cumple la condicion entonces pega la informacion en dicha celda (B3)
ActiveCell.Offset(0, 1).Activate
ActiveSheet.Paste
Else
'sino entonces se corre hasta la ultima celda con datos + 1
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Activate
'y pega la informacion
ActiveSheet.Paste
End If
End If
Application.CutCopyMode = False
'activamos nuevamente la hoja 1
Sheets("Hoja1").Activate
'en la celda C3
Range("C3").Select
Application.Calculate
Application.ScreenUpdating = True
End Sub
Si esto resuelve el problema por favor comenta y cierra la pregunta, en caso contrario no dudes en preguntarme nuevamente.