Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » macro copiar hacia abajo

Excel - macro copiar hacia abajo

Volver
Nuevo Tema
<<>>
 
Vista:

macro copiar hacia abajo

Publicado por analia (3 intervenciones) el 01/06/2014 00:52:32
Hola, necesito armar una macro para copiar datos desde una tabla hacia a otra, mi problema es que la segunda tabla se trata de un histórico, es decir, la primer tabla es para ingresar siempre en ese lugar los datos y lo que quiero es que la macro los copie y los pegue en la segunda pero a la siguiente vez que ingrese datos quiero que copie y pegue en la fila de abajo para generar un histórico.

No se nada de códigos, solo se grabar macros manualmente.

Me pueden ayudar?
Gracias!!!
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de JuanC

macro copiar hacia abajo

Publicado por JuanC (1237 intervenciones) el 01/06/2014 14:41:50
una posibilidad...

1
2
3
4
5
6
Dim rng As Range
Set rng = Range("A" & Cells.Rows.Count).End(xlUp)
If rng.Value <> "" Then
   Set rng = rng.Offset(1)
End If
rng.Value = "nuevo valor"

Saludos, desde Baires, JuanC
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

macro copiar hacia abajo

Publicado por analia (3 intervenciones) el 01/06/2014 20:59:07
Casi!, pega todo en el mismo lugar, te copio mi código a ver si vos encontras el problema
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Macro3()
'

' Macro3 Macro

' secado semanal

'

 
'

    Range("J9").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("K9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=True
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Historico").Select
    Dim rng As Range
Set rng = Range("A" & Cells.Rows.Count).End(xlUp)
If rng.Value <> "" Then
   Set rng = rng.Offset(1)
End If
rng.Value = ActiveSheet.Paste
    Sheets("Registro semanal secado").Select
    Range("A1").Select
End Sub

Gracias!!
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de JuanC

macro copiar hacia abajo

Publicado por JuanC (1237 intervenciones) el 01/06/2014 22:14:08
parece que ni jota de programación...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Macro3()
Dim rng As Range
Range("J9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("K9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=True
Application.CutCopyMode = False
 
Set rng = Sheets("Historico").Range("A" & Cells.Rows.Count).End(xlUp)
If rng.Value <> "" Then
   Set rng = rng.Offset(1)
End If
 
Selection.Copy rng
End Sub

Saludos, desde Baires, JuanC
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

macro copiar hacia abajo

Publicado por analia (3 intervenciones) el 01/06/2014 22:53:06
Funciona perfecto, es verdad nada de nada de programación!

Muchas gracias
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 3
Ha aumentado su posición en 10 puestos en Excel (en relación al último mes)
Gráfica de Excel

macro copiar hacia abajo

Publicado por Carlos (1 intervención) el 12/01/2021 18:45:45
Buen Dia,

mi situacion es la siguiente, tengo el cuadro que se muestra en la imagen 1, ahi se deberia cargar la informacion y al presionar guardar la data deberia pasar a la tabla que se muestra en la imagen 2, esto lo hace pero al cargar nuevamente deberia ir guardando debajo de la data que ya existe para mantener el historico, no he logrado hacerlo... no se que me esta faltando en mi codigo o que tengo mal... si pueden ayudarme

imagen 1
1

imagen 2
2

codigo usado




1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
Sub Guardar1()
OPCION = MsgBox("¿Desea guardar en la base de datos?. Perdera la información del reporte diario.", vbYesNo)
 
If OPCION = vbYes Then
'DESACTIVANDO EL MOVIMIENTO DE PANTALLA
Application.ScreenUpdating = False
'comentado el 1804
        'mostrando hoja historico
        'Sheets("HISTORICO").Visible = True
'inicializando variables
    'Separador = Application.International(xlListSeparator) ' NO UTILIZADO
 
    'creamos la variable contador para guardar el indice del ultimo registro
    Dim contador As Integer
    Dim Sheetss As String
    Dim resultString As String
    Dim celdabool As Boolean
    Dim rng As Range
 
 
'Funcion que busca los datos
        For A = 6 To 25
        'seleccionamos la hoja registro (Donde se llenan las liberaciones)
        Sheets("REGISTRO").Activate
        'desprotegiendo la hoja
        Sheets("REGISTRO").Unprotect Password:="STM2020*"
 
        Next
 
        'ciclo para insertar los registros (Si estan llenos) en la hoja historicos
        '(revisando desde la fila 6 a la 25)
        'revision si la celda esta vacia
        'para no copiar en el historico una celda vacia
        Sheetss = Cells(A, 25).Value
 
        Select Case Sheetss
                    Case Is = "SI"
                        resultString = "APROBADO"
                    Case Is = "RT"
                        resultString = "RETENCION"
                        'Buscamos la hoja correspondiente a el estatus para saber cual es el ultimo indice de registro
                        Sheets("RETENCION").Select
 
        End Select
 
 
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("O3").Select
 
 
Set rng = Sheets("REGISTRO").Range("A" & Cells.Rows.Count).End(xlUp)
If rng.Value <> "" Then
   Set rng = rng.Offset(1)
End If
 
 
 
 
            celdabool = IsEmpty(Cells(A, 6))
             'If (Sheetss <> "") Then
                ' no esta vacia
                'aumentando el contador de la hoja historico
                contador = contador + 1
 
                                'igualando celda por celda
                Select Case Sheetss
                    Case Is = "SI"
                    'Buscamos la hoja correspondiente a el estatus para saber cual es el ultimo indice de registro
                    Sheets("APROBADO").Select
                    'se llena la variable
                    contador = Application.WorksheetFunction.CountA(Range("A:A")) + 2
                    Worksheets("APROBADO").Cells(contador, 1).Value = contador - 3
                    Worksheets("REGISTRO").Cells(A, 1).Value 'se cambia para funcionar con el numero de registro
                    Worksheets("APROBADO").Cells(contador, 2).Value = Worksheets("REGISTRO").Cells(A, 3).Value
                    Worksheets("APROBADO").Cells(contador, 3).Value = Worksheets("REGISTRO").Cells(A, 4).Value
                    Worksheets("APROBADO").Cells(contador, 4).Value = Worksheets("REGISTRO").Cells(A, 5).Value
                    Worksheets("APROBADO").Cells(contador, 5).Value = Worksheets("REGISTRO").Cells(A, 6).Value
                    Worksheets("APROBADO").Cells(contador, 6).Value = Worksheets("REGISTRO").Cells(A, 7).Value
                    Worksheets("APROBADO").Cells(contador, 7).Value = Worksheets("REGISTRO").Cells(A, 8).Value
                    Worksheets("APROBADO").Cells(contador, 8).Value = Worksheets("REGISTRO").Cells(A, 9).Value
                    Worksheets("APROBADO").Cells(contador, 9).Value = Worksheets("REGISTRO").Cells(A, 10).Value
                    Worksheets("APROBADO").Cells(contador, 10).Value = Worksheets("REGISTRO").Cells(A, 11).Value
                    Worksheets("APROBADO").Cells(contador, 11).Value = Worksheets("REGISTRO").Cells(A, 12).Value
                    Worksheets("APROBADO").Cells(contador, 12).Value = Worksheets("REGISTRO").Cells(A, 13).Value
                    Worksheets("APROBADO").Cells(contador, 13).Value = Worksheets("REGISTRO").Cells(A, 14).Value
                    Worksheets("APROBADO").Cells(contador, 14).Value = Worksheets("REGISTRO").Cells(A, 15).Value
                    Worksheets("APROBADO").Cells(contador, 15).Value = Worksheets("REGISTRO").Cells(A, 16).Value
                    Worksheets("APROBADO").Cells(contador, 16).Value = Worksheets("REGISTRO").Cells(A, 17).Value
                    Worksheets("APROBADO").Cells(contador, 17).Value = Worksheets("REGISTRO").Cells(A, 18).Value
                    Worksheets("APROBADO").Cells(contador, 18).Value = Worksheets("REGISTRO").Cells(A, 19).Value
                    Worksheets("APROBADO").Cells(contador, 19).Value = Worksheets("REGISTRO").Cells(A, 20).Value
                    Worksheets("APROBADO").Cells(contador, 20).Value = Worksheets("REGISTRO").Cells(A, 21).Value
 
                End Select
 
 
            End If
 
 
        'codigo en desuso 1
 
        Range("A6:O25").Select
        Selection.Copy
        contador = Application.WorksheetFunction.CountA(Range("A:A")) + 2
        contador = contador + 1
        Cells(contador + 1, 1).Select
 
        Sheets("APROBADO").Select
        ActiveSheet.Paste
 
        'codigo en desuso 1
 
'INICIO DEL METODO QUE BORRARA EL CUADRO AL 12/01/2020
        Sheets("REGISTRO").Select
        Range("A6:O25").Select ' METODO QUE SELECCIONA EL CUADRO PARA BORRAR
        Selection.ClearContents ' FUNCION QUE BORRA
        Application.ScreenUpdating = True  'REACTIVANDO EL MOVIMIENTO DE PANTALLA
 
        Sheets("REGISTRO").Protect Password:="STM2020*"
 
 
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar