Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Error en la macro,

faty23

Por faty23
en Macros y programación VBA

Recommended Posts

faty23 Novato

faty23

publicado
publicado

Hola

He creado el siguiente código para introducir datos en excel. De manera que el código detecte cual es la última fila escrita, se sitúe en la siguiente y vaya pidiendo la información y la vaya colocando en la celda correspondiente de la columna.

Private Sub CommandButton2_Click()

Dim Nombre As String

Dim tipología As String

Dim CSAP As String

Dim CANTG As String

Dim Sistema_Operativo As String

Dim Características_Tecnológicas As String

Dim Fecha_Inclusión_Catálogo As Date

Dim Terminal_sin_Alta As Integer

Dim SPGE As Integer

Dim Apoyo_Canje As Integer

Dim Pantalla As Integer

Dim Duración_Batería As String

Dim Dimensiones As Integer

Dim Peso As Integer

Dim Fila As String

Dim Columna As String

Dim jj

Dim nn

Nombre = Val(InputBox("Introduzca_el_nombre_del_nuevo_modelo(return para terminal):", "Nombre"))

tipología = Val(InputBox("Introduzca_la_tipología_del_nuevo_modelo", "Entrar"))

CSAP = Val(InputBox("Introduzca_CSAP", "Entrar"))

CANTG = Val(InputBox("Introduzca_CANTG", "Entrar"))

Sistema_Operativo = Val(InputBox("Introduzca el Sistema_Operativo", "Entrar"))

Características_Tecnológicas = Val(InputBox("Introduzca_las_características", "Entrar"))

Fecha_Inclusión_Catálogo = CDate(InputBox("Introduzca_Fecha_Inclusión", "Entrar"))

Terminal_sin_Alta = Val(InputBox("Introduzca_Terminal_sin_alta", "Entrar"))

Terminal_con_Alta = Val(InputBox("Introduzca_Terminal_con_Alta", "Entrar"))

SPGE = Val(InputBox("Introduzca_SPGE", "Entrar"))

Apoyo_Canje = Val(InputBox("introduzca_El_Apoyo_de_Canje", "Entrar"))

Pantalla = Val(InputBox("Introduzca_el_Tamaño_Pantalla", "Entrar"))

Duración_Batería = Val(InputBox("Introduzca_la_duración_de_la_Batería", "Entrar"))

Dimensiones = Val(InputBox("Introduzca_las_dimensiones_del_terminal", "Entrar"))

Peso = Val(InputBox("Introduzca el peso", "Entrar"))

With ActiveCell

.Value = Nombre

.Offset(0, 4).Value = tipología

.Offset(0, 5).Value = CSAP

.Offset(0, 6).Value = CANTG

.Offset(0, 7).Value = Sistema_Operativo

.Offset(0, 8).Value = Características_Tecnológicas

.Offset(0, 9).Value = Fecha_Inclusión_Catálogo

.Offset(0, 10).Value = Terminal_sin_Alta

.Offset(0, 11).Value = Terminal_con_Alta

.Offset(0, 12).Value = SPGE

.Offset(0, 13).Value = Apoyo_Canje

.Offset(0, 14).Value = Pantalla

.Offset(0, 15).Value = Duración_Batería

.Offset(0, 16).Value = Dimensiones

.Offset(0, 17).Value = Peso

End With

ActiveCell.Offset(1, 0).Activate

"MsgBox("Deseas_continuar",vbYesNo + vbQuestion, "opci" ///no sabría como ponerlo///

End Sub

¿Qué es lo que falla? ¿que no me copia en la celda correspondiente? No tengo mucho conocimiento de excel y es un curro, yo creo que me falta código

Gracias

Un saludo

faty23 Novato

faty23

publicado
  • Autor
publicado

- - - - - Mensaje combinado - - - - -

TE lo puedo mandar por msj o algo. Es que ocupa mucho y le he quitado bastante cosas pero sigue siendo grande.

Soy nueva en el foro, perdonad por estar tan verde

Lo he comprimido y se sige pasando.

ULISES Novato

ULISES

publicado
publicado

Yo uso esto para guardar mis datos de un formulario a una base de datos lineal.

Aplico uno por cada celda a copiar en este caso el codigo qt muestro tiene todas las celdas de mi formulario.

Sub GUARDAR1()
'
' GUARDAR1 Macro
' Macro grabada el 16/03/2010 por ULISES GONZALES
' Macro grabada el 21/03/2011 por ULISES GONZALES
'
Dim oProgress As New frm_lcf_ProgressBar
    Dim style As Integer
    Dim windowCaption As String
    Dim endRow As Long
    Dim i As Long
    style = 2
    windowCaption = "SE ESTAN GUARDANDO LOS REGISTROS"
    endRow = 50000
    oProgress.Initialize endRow, style, windowCaption
    oProgress.Show 0
    For i = 0 To endRow - 4
              oProgress.Increase
    Next
    oProgress.Increase 4
    Unload oProgress

Application.ScreenUpdating = False
Sheets("ESTADISTICA DE TRANSCRIPCION").Select
    Range("D6").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("D4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("D" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("B6").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("E4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("E" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
        With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("I15").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("F4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("F" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("B14").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("G4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("G" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("E14").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("H4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("H" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("I14").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("I4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("I" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("E15").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("J4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("J" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("F6").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("K4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("K" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("H6").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("L4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("L" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("J6").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("M4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("M" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("B8").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("N4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("N" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("D8").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("O4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("O" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("H8").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("P4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("P" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("E21").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("Z4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("Z" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With


       Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("G21").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AA4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AA" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("E22").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AB4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AB" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("G22").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AC4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AC" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("K23").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AD4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AD" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

          Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("F23").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AE4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AE" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("G24").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AF4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AF" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("B12").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AG4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AG" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("E12").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AH4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AH" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("G12").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AI4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AI" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("I12").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AJ4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AJ" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("B17").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AK4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AK" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("B19").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AL4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AL" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("J6").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AM4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AM" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate
    Range("B6").Select
    Selection.Copy
    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate
    Sheets("ESTADISTICAS DIARIAS").Select
    Range("AN4").Select
    ActiveCell.End(xlDown).Select
    ultima = ActiveCell.Row + 1
    Range("AN" & ultima).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
        With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

Application.ScreenUpdating = Trae

End Sub[/code]

- - - - - Mensaje combinado - - - - -

Yo uso esto para guardar mis datos de un formulario a una base de datos lineal.

Aplico uno por cada celda a copiar en este caso el codigo qt muestro tiene todas las celdas de mi formulario.

Sub GUARDAR1()

'

' GUARDAR1 Macro

' Macro grabada el 16/03/2010 por ULISES GONZALES

' Macro grabada el 21/03/2011 por ULISES GONZALES

'

Dim oProgress As New frm_lcf_ProgressBar

    Dim style As Integer

    Dim windowCaption As String

    Dim endRow As Long

    Dim i As Long

    style = 2

    windowCaption = "SE ESTAN GUARDANDO LOS REGISTROS"

    endRow = 50000

    oProgress.Initialize endRow, style, windowCaption

    oProgress.Show 0

    For i = 0 To endRow - 4

              oProgress.Increase

    Next

    oProgress.Increase 4

    Unload oProgress


Application.ScreenUpdating = False

Sheets("ESTADISTICA DE TRANSCRIPCION").Select

    Range("D6").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("D4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("D" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("B6").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("E4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("E" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

        Application.CutCopyMode = False

        With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("I15").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("F4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("F" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("B14").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("G4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("G" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("E14").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("H4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("H" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("I14").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("I4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("I" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("E15").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("J4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("J" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("F6").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("K4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("K" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("H6").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("L4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("L" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("J6").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("M4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("M" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("B8").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("N4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("N" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("D8").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("O4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("O" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("H8").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("P4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("P" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("E21").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("Z4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("Z" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With



       Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("G21").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AA4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AA" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("E22").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AB4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AB" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("G22").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AC4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AC" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("K23").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AD4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AD" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


          Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("F23").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AE4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AE" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("G24").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AF4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AF" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("B12").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AG4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AG" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("E12").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AH4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AH" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("G12").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AI4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AI" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("I12").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AJ4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AJ" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("B17").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AK4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AK" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("B19").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AL4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AL" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("J6").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AM4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AM" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


        Windows("SISTEMA 0800BOMBONA 4.1 Año-2011.xls").Activate

    Range("B6").Select

    Selection.Copy

    Windows("STADISTICAS 0800Bombona Nº1.xls").Activate

    Sheets("ESTADISTICAS DIARIAS").Select

    Range("AN4").Select

    ActiveCell.End(xlDown).Select

    ultima = ActiveCell.Row + 1

    Range("AN" & ultima).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

        Application.CutCopyMode = False

        With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

        End With


Application.ScreenUpdating = Trae


End Sub[/CODE]

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.