Códigos
Reemplazo de caracteres:
Sub remplt()
txtSup = InputBox("¿Qué cadena de caracteres deseas suprimir?")
txtRemp = InputBox("¿Por cuál desea reemplazarla?")
Application.ScreenUpdating = False
For Each c In Selection
c.Value = Replace(c.Value, txtSup, txtRemp)
Next c
End Sub
Condicional
Sub Condicional()
ActiveSheet.Range("A1").Value = 0 ' Poner las casillas donde se guardan los valores 0.
ActiveSheet.Range("A2").Value = 0
ActiveSheet.Range("A3").Value = 0
ActiveSheet.Range("A1").Value = Val(InputBox("Ingresa el precio", "Entrar"))
' Si el valor de la casilla A1 es mayor que 1000, entonces, pedir descuento
If ActiveSheet.Range("A1").Value > 1000 Then
ActiveSheet.Range("A2").Value = Val(InputBox("Ingresa el Descuento", "Entrar"))
End If
ActiveSheet.Range("A3").Value = ActiveSheet.Range("A1").Value - ActiveSheet.Range("A2").Value
End Sub
Mismo Condicional pero con variables
Sub Condicional()
Dim Precio As Integer
Dim Descuento As Integer
Precio = 0
Descuento = 0
Precio = Val(InputBox("Ingresa el precio", "Entrar"))
' Si el valor de la variable precio es mayor que 1000, entonces, pedir descuento
If Precio > 1000 Then
Descuento = Val(InputBox("Ingresa el Descuento", "Entrar"))
End If
ActiveSheet.Range("A1").Value = Precio
ActiveSheet.Range("A2").Value = Descuento
ActiveSheet.Range("A3").Value = Precio - Descuento
End Sub
Copia datos filtrados en otra hoja
Sub Copiar_filtro()
If ActiveSheet.AutoFilterMode = False Then
Exit Sub
End If
ActiveSheet.AutoFilter.Range.Copy
Workbooks.Add.Worksheets(1).Paste
Cells.EntireColumn.AutoFit
Application.DisplayAlerts = False
Sheets("Hoja2").Delete
Sheets("Hoja3").Delete
End Sub
Copiar Información
Sub Registros()
' Copiar Registros
Dim i As Integer 'Declaración de variable i, para el ciclo For
Dim j As Integer
For j = 1 To 5
ActiveCell.Select
ActiveCell.Offset(0, 0).Select
Range(ActiveCell(1, 1), ActiveCell.Offset(0, 3)).Select
Selection.Copy
Sheets("Hoja1").Select
Do While ActiveCell <> Empty
ActiveCell.Offset(1, 0).Select
Loop
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------------
For i = 1 To 3
ActiveCell.Select
ActiveCell.Offset(0, 0).Select
Range(ActiveCell(1, 1), ActiveCell.Offset(0, 3)).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial
Application.CutCopyMode = False
Next i
Sheets("Registro").Select
ActiveCell.Offset(1).Select
Next j
End Sub
Sub Copiar_Clipper()
Dim i As Integer
For i = 1 To 10
'Seleccionamos la celda activa
ActiveCell.Select
'Seleccionamos celda activa, siempre y cuando no esté vacía
If ActiveCell <> Empty Then
ActiveCell.Offset(1, 0).Select
If ActiveCell = Empty Then
ActiveCell.Offset(-1, 0).Select
'Selecciona la celda activa
Range(ActiveCell(1, 1), ActiveCell.Offset(0, 0)).Select
'Copia el contenido de la celda
Selection.Copy
'Avanza una fila hacia abajo
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Pega lo que copio
ActiveSheet.Paste
'Desactiva selección de celda
Application.CutCopyMode = False
'Avanzamos a la siguiente celda
ActiveCell.Offset(1, 0).Select
End If
End If
If ActiveCell = Empty Then
ActiveCell.Offset(-1, 0).Select
End If
End Sub