Excel Consultor: Opciones para almacenar información

Sub Opcion1()
'COPIAR INFORMACIÓN LINEAL DE UN RANGO Y
'ALMACENAR EN OTRA HOJA DENTRO DE UNA TABLA -  OPCIÓN CORTA V1



Dim oldRows&, Rng As Range, mFila As Range
Application.ScreenUpdating = False

Set Rng = Range([B2].End(xlDown), [B2].End(xlToRight).Offset(0))
With Hoja2.[a2].ListObject
  oldRows = .Range.Rows.Count
  If .ListRows.Count = 0 Then oldRows = oldRows - 1
  Set mFila = .ListRows.Add.Range
  .Resize .Range.Resize(oldRows + Rng.Rows.Count)
  mFila.Resize(Rng.Rows.Count) = Rng.Value
End With
Application.ScreenUpdating = True
MsgBox "Se agregó información a la data", vbOKOnly + vbInformation, "Excel Consultor" 'Muestra un aviso ejecutada la macro.


'Información:
'El código asume que la celda superior izquierda del rango de datos "de origen" está en la celda [B2]
'Si este rango base crece (en filas o en columnas) no se tiene que hacer nada.
'La celda superior izquierda de tu ListObject (TABLA) es [A2].
End Sub

Sub Opcion2()
'COPIAR INFORMACIÓN LINEAL Y ALMACENAR EN OTRA HOJA, EN LA MISMA POSICIÓN Y CUMPLIENDO UNA CONDICIÓN.



Application.ScreenUpdating = False ' |(Evita el parpadeo de la pantalla)

'inicializo la variable j
j = 2

    'comienzo el bucle
    For i = 2 To 19
        
        'activo la hoja donde están mis datos
        Sheets("Hoja1").Activate
            
            'compruebo que el valor de la fecha es mayor que 30
            If Cells(i, "A").Value = "x" Then
                'copio la fila entera
                'Set Rng = Range([B2].End(xlDown), [B2].End(xlToRight).Offset(0))
               Range(Cells(i, "B"), Cells(i, "L")).Copy
 'selecciono la hoja donde quiero pegar y después la celda
                Sheets("Data").Activate
                    Cells(j, "A").PasteSpecial Paste:=xlPasteValues
                'pego la fila que hemos copiado
                'aumento la variable j para que vaya a la siguiente fila de la hoja filtros
                'cuando encuentre una nueva fila que cumple con la condición de edad
                j = j + 1
            End If
    
    Next
Application.CutCopyMode = False '|Desactiva el modo copiar
MsgBox "Se agregó información a la data", vbOKOnly + vbInformation, "Excel Consultor" 'Muestra un aviso ejecutada la macro.

End Sub

Sub Opcion3()
'COPIAR INFORMACIÓN LINEAL Y ALMACENAR EN OTRA HOJA DENTRO DE UNA TABLA - OPCIÓN CORTA V2


Application.ScreenUpdating = False ' |(Evita el parpadeo de la pantalla)

Range("B2:L19").Select '=> Selecciona el rango a copiar.

Selection.Copy '=> Copia el rango.

Sheets("data").Select '=> Selecciona la hoja donde se pegará la información.

Range("A1").Select '=> Selecciona el título de la tabla donde se almacenará la información.

Selection.End(xlDown).Select '=> Selecciona la última celda con datos de la tabla.

ActiveCell.Offset(0, 0).Activate '=> Selecciona la celda que se encuentra debajo de la celda activa.

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False 'Pega la información.

Sheets("Hoja1").Select '=> Regresa a la hoja de registro.

Range("a1").Select '=> Selecciona una celda en particular de la hoja de registro.

Application.CutCopyMode = False '|Desactiva el modo copiar


MsgBox "Se agregó información a la data", vbOKOnly + vbInformation, "Excel Consultor" 'Muestra un aviso ejecutada la macro.



'Nota:
'Si la hoja de destino contiene una tabla donde se almacenará la información, se deberá cambiar el :
'ActiveCell.Offset(1, 0).Activate
'Por:
'ActiveCell.Offset(0, 0).Activate

End Sub

Sub Opcion4()
'COPIAR INFORMACIÓN LINEAL Y ALMACENAR EN OTRA HOJA CUMPLIENDO CONDICIÓN DEFINIDA DE UNA FILA


  
Dim NombreHoja As String
Dim HojaDestino As Range
Dim NuevaFila As Integer

Application.ScreenUpdating = False ' |(Evita el parpadeo de la pantalla)


    'comienzo el bucle
    For i = 2 To 19
        
        'activo la hoja donde están mis datos
        Sheets("Hoja1").Activate
            
            'compruebo que el valor de la fecha es mayor que 30
            If Cells(i, "A").Value = "x" Then
                'copio la fila entera
                 Range(Cells(i, "B"), Cells(i, "L")).Copy
 'selecciono la hoja donde quiero pegar y después la celda
 
  NombreHoja = "Data"
    Set HojaDestino = ThisWorkbook.Sheets(NombreHoja).Range("a1").CurrentRegion
    NuevaFila = HojaDestino.Rows.Count + 1
 
                Sheets("Data").Activate
                    Cells(NuevaFila, "A").PasteSpecial Paste:=xlPasteValues 'pego la fila que hemos copiado
                End If
    
    Next
Application.CutCopyMode = False '|Desactiva el modo copiar
MsgBox "Se agregó información a la data", vbOKOnly + vbInformation, "Excel Consultor" 'Muestra un aviso ejecutada la macro.


End Sub

Sub Opcion5()
'COPIAR INFORMACIÓN NO LINEAL Y ALMACENAR EN UNA FILA DENTRO  DE UNA TABLA EN OTRA HOJA - OPCION LARGA


  
    Dim NombreHoja As String
    Dim HojaDestino As Range
    Dim NuevaFila As Integer
    
    Dim Pregunta As Integer

  'CONDICIONALES PREVIAS AL REGISTRO:
  'If Range("c1").Value = "" Or Range("c2").Value = "" Or Range("h1").Value = "" Then
   ' MsgBox "Debe completar la información de Red, Lugar y Representante", , "Excel Consultor": Exit Sub
    
    'End If
Pregunta = MsgBox("¿Estás seguro de registrar la información?", vbOKCancel, "Excel Consultor")
    If Pregunta = 2 Then Exit Sub
        
    NombreHoja = "Data"
    Set HojaDestino = ThisWorkbook.Sheets(NombreHoja).Range("A1").CurrentRegion
    NuevaFila = HojaDestino.Rows.Count + 1
   
    
    With ThisWorkbook.Sheets(NombreHoja)
        
        .Cells(NuevaFila, 1).Value = Range("B2").Value
        .Cells(NuevaFila, 2).Value = Range("C2").Value
        .Cells(NuevaFila, 3).Value = Range("D2").Value
        .Cells(NuevaFila, 4).Value = Range("E2").Value
        .Cells(NuevaFila, 5).Value = Range("F2").Value
        .Cells(NuevaFila, 6).Value = Range("G2").Value
        .Cells(NuevaFila, 7).Value = Range("H2").Value
        .Cells(NuevaFila, 8).Value = Range("I2").Value
        .Cells(NuevaFila, 9).Value = Range("J2").Value
        .Cells(NuevaFila, 10).Value = Range("K2").Value
        .Cells(NuevaFila, 11).Value = Range("L2").Value
        
    End With
  
    MsgBox "Registro Exitoso.", vbInformation, "Excel Consultor"

End



End Sub

Sub Opcion6()
'COPIAR INFORMACIÓN NO LINEAL Y ALMACENAR EN VARIAS FILAS Y COLUMNAS DENTRO  DE UNA TABLA EN OTRA HOJA - OPCION LARGA

  
Dim Pregunta As Integer


Pregunta = MsgBox("¿Deseas registrar la Venta?", vbOKCancel, "Excel Consultor")
    If Pregunta = 2 Then MsgBox "Se canceló la ejecución", , "Excel Consultor": Exit Sub
    
    'Se puede usar este botón para ejecutar macros
    'cuya ejecución dependerá si se presiona el botón aceptar.
    
'CONDICIONALES PREVIAS AL REGISTRO:
'If Range("G4").Value = "" Or Range("C5").Value = "" Or Range("B9").Value = "" Or Range("G6").Value = "" Or Range("c32").Value = "" Then MsgBox "FALTA DATOS"
'If Range("G4").Value = "" Or Range("C5").Value = "" Or Range("B9").Value = "" Or Range("G6").Value = "" Or Range("c32").Value = "" Then Exit Sub

With Sheets("DATA").Range("a65536").End(xlUp)

.Offset(1, 0) = Range("B2").Value
.Offset(2, 0) = Range("B3").Value
.Offset(3, 0) = Range("B4").Value
.Offset(4, 0) = Range("B5").Value
.Offset(5, 0) = Range("B6").Value
.Offset(6, 0) = Range("B7").Value
.Offset(7, 0) = Range("B8").Value
.Offset(8, 0) = Range("B9").Value

.Offset(1, 1) = Range("C2").Value
.Offset(2, 1) = Range("C3").Value
.Offset(3, 1) = Range("C4").Value
.Offset(4, 1) = Range("C5").Value
.Offset(5, 1) = Range("C6").Value
.Offset(6, 1) = Range("C7").Value
.Offset(7, 1) = Range("C8").Value
.Offset(8, 1) = Range("C9").Value
MsgBox "Se registró exitosamente", vbInformation, "Excel Consultor"
 Range("G4").Select
End With

End Sub

Sub Opcion7()
'METODO RÁPIDO PARA MILES DE FILAS
'COPIAR INFORMACIÓN DE FILAS Y ALMACENAR EN OTRA HOJA CUMPLIENDO CONDICIÓN 
'ESPECÍFICA SEGÚN EL CONTENIDO DE LA CELDA DE LA FILA

Dim ORDEN  As String
Dim cate  As String
Dim FECHA As String
Dim IMPORTE As String

Dim ultimafila As Long
Dim ultimafilaAux As Long
Dim contador As Long

Dim palabra As String

'palabra = Sheets("HojaInicial").Cells(3, 3)
'palabra = "Excel"

ultimafila = Sheets("HojaInicial").Range("d" & Rows.Count).End(xlUp).Row

If ultimafila < 3 Then
Exit Sub
End If


Dim t0, t1 As Variant
t0 = Format(Now, "hh:mm:ss")


Call ControlaEntrada


For contador = 4 To ultimafila

'If Sheets("HojaInicial").Cells(contador, 3) = palabra Then
If Sheets("HojaInicial").Cells(contador, 11) > 0 Then

ORDEN = Sheets("HojaInicial").Cells(contador, 4)
cate = "Evento"
FECHA = Sheets("HojaInicial").Cells(contador, 6)
IMPORTE = Sheets("HojaInicial").Cells(contador, 10)

'Hoja de destino:
ultimafilaAux = Sheets("HojaDestino").Range("d" & Rows.Count).End(xlUp).Row
Sheets("HojaDestino").Cells(ultimafilaAux + 1, 4) = ORDEN
Sheets("HojaDestino").Cells(ultimafilaAux + 1, 5) = cate
Sheets("HojaDestino").Cells(ultimafilaAux + 1, 6) = FECHA
Sheets("HojaDestino").Cells(ultimafilaAux + 1, 11) = IMPORTE

End If
Next contador

ultimafilaAux = Sheets("HojaDestino").Range("b" & Rows.Count).End(xlUp).Row
Call ControlaSalida
t1 = Format(Now, "hh:mm:ss")
tiempo = Format(TimeValue(t1) - TimeValue(t0), "hh:mm:ss")
MsgBox "Se procesaron todos los registros en: " & Chr(13) & tiempo & Chr(13) & "hh:mm:ss", vbOKOnly + vbInformation, "Excel Consultor"    'Muestra un aviso ejecutada la macro.



End Sub

...

Páginas

Opciones para almacenar información