Jump to content

Antoni

Members
  • Posts

    11,090
  • Joined

  • Last visited

  • Days Won

    747

Everything posted by Antoni

  1. Sub CopiarMúltiple() Application.ScreenUpdating = False Range("C3:I7").Copy For x = 12 To 4998 Step 9 Range("C" & x).PasteSpecial xlPasteAll Next Application.CutCopyMode = False End Sub
  2. Range("B2:B" & ActiveSheet.UsedRange.Rows.Count) = "DIGITAL"
  3. Yo no me preocuparía demasiado, es que además, para media docena de notas.....
  4. Sub EliminarColumnasNoChiclayo() Application.ScreenUpdating = False For y = Cells(2, Columns.Count).End(xlToLeft).Column To 3 Step -1 If Not Cells(2, y) Like "*Chiclayo*" Then Columns(y).Delete Next End Sub
  5. Sub FormatoNúmeros() Dim R As Range, Texto As String Application.ScreenUpdating = False ActiveSheet.Copy After:=ActiveSheet For x = 2 To Hoja1.Range("A" & Rows.Count).End(xlUp).Row For y = 7 To Hoja1.Cells(1, Columns.Count).End(xlToLeft).Column Texto = Trim(Hoja1.Cells(x, y)) Set R = Sheets("Cuestionario Horizontal").Columns(y - 6).Find(Texto, , , xlWhole) If Not R Is Nothing Then If Not R = "" Then Cells(x, y) = R.Row - 1 Next Next End Sub
  6. Sub crearHoja() Dim Hoja As String Hoja = "Benito" '<---------- Tu hoja nueva If ExisteHoja(Hoja) Then MsgBox "Ya existe la hoja " & Hoja, vbCritical Else Sheets.Add(After:=Sheets(Sheets.Count)).Name = Hoja MsgBox "Se ha creado la hoja " & Hoja, vbInformation End If End Sub Function ExisteHoja(Hoja As String) As Boolean For h = 1 To Sheets.Count If Sheets(h).Name = Hoja Then ExisteHoja = True Exit Function End If Next h End Function
  7. Abre el adjunto y pulsa la flecha azul. Esta es la macro. Sub OrdenarFiltro() Application.CopyObjectsWithCells = False '<-- Para no copiar las autoformas Application.ScreenUpdating = False With Hoja2 .UsedRange.Clear Hoja1.UsedRange.SpecialCells(xlCellTypeVisible).Copy .Cells .UsedRange.Sort Key1:=.Columns("C"), Key2:=.Columns("B"), Header:=xlYes .Select End With Application.CopyObjectsWithCells = True End Sub
  8. ¿En el mismo rango? ¿En otro rango en la misma hoja? ¿En otra hoja? Lo más sencillo es la opción 3.
  9. Utiliza Cells(x,).Text en lugar de Cells(x,y).Value
  10. Te dejo una UDF, úsala como fórmula o en una macro. Function ConvertirFecha(ByVal Fecha) As Variant ConvertirFecha = CDate(Replace(Fecha, ".", "/")) End Function La celda debe tener formato fecha (dd/mm/aaaa)
  11. Sub Desordenar() Application.ScreenUpdating = False Range("A:C").Copy Range("F:H") Columns("D").Clear x = Range("A" & Rows.Count).End(xlUp).Row filas = 2 Do Until filas > x fila = Int(Rnd * x) + 1 If fila > 1 Then If Range("D" & fila) = "" Then Range("D" & fila) = "x" Range("A" & fila).Resize(1, 3).Copy Range("F" & filas) filas = filas + 1 End If End If Loop Range("F:I").Cut Range("A:D") End Sub Peo mejor usar la macro de Gerson.
  12. 😂 😂 😂 Se me olvidó subir el archivo. MAleatorio.xlsm
  13. Por alguna razón, ciertos errores se escapan a On Error, así te funcionará. Sub pruebaImg(): On Error Resume Next Sheets("Full2").Select Sheets("Full1").Shapes("Imagen1").Copy If Err.Number = 0 Then Range("c1").Select ActiveSheet.Paste End If Err.Number = 0 Sheets("Full1").Shapes("Imagen2").Copy If Err.Number = 0 Then Range("e1").Select ActiveSheet.Paste End If Err.Number = 0 Sheets("Full1").Shapes("Imagen3").Copy If Err.Number = 0 Then Range("i1").Select ActiveSheet.Paste End If Err.Number = 0 Sheets("Full1").Shapes("Imagen4").Copy If Err.Number = 0 Then Range("m1").Select ActiveSheet.Paste End If Err.Number = 0 Sheets("Full1").Shapes("Imagen5").Copy If Err.Number = 0 Then Range("r1").Select ActiveSheet.Paste End If End Sub
  14. No es necesario recurrir a la columna en letras utilizando la propiedad Cells del objeto Range. Private Sub BtGrabar_Click() Dim celda As Range, x As Long, Incidencias As Range Application.ScreenUpdating = False If CBoxPeriodo.ListIndex = -1 Then Exit Sub With Sheets("PARQUE") Set celda = .Range("A1:AZ1").Find(CBoxPeriodo, , , xlWhole) Set Incidencias = .Range("A1:AZ1").Find("INCIDENCIA", , , xlPart) .Columns(celda.Column).ClearComments For x = 2 To .Cells(Rows.Count, Incidencias.Column).End(xlUp).Row If Not .Cells(x, Incidencias.Column).Value = "" Then .Cells(x, celda.Column).AddComment .Cells(x, celda.Column).Comment.Text Text:=.Cells(x, Incidencias.Column).Value End If Next End With Application.ScreenUpdating = True End Sub
  15. ¿Ordenar de forma aleatoria?, o sea, desordenar. ¿No?😂 Lo miro luego, que ahora he de ir a pasar la ITV.
  16. Sub OrigenToDestino() Sheets("origen").Range("A2:F" & Sheets("origen").Range("A" & Rows.Count).End(xlUp).Row).Copy _ Sheets("destino").Range("A" & Sheets("destino").Range("A" & Rows.Count).End(xlUp).Row + 1) End Sub
  17. Set celda = Columns("D").Find(número, , ,xlWhole)
  18. Sub Importar_Fichero() Dim Archivo As Variant Dim Examinar As Object '-- ChDir ThisWorkbook.Path Set Examinar = Application.FileDialog(msoFileDialogFilePicker) With Examinar .AllowMultiSelect = True .Title = "Seleccionar archivos a consolidar" If .Show = -1 Then Sheets("Hoja1").Range("A2:AO" & Rows.Count).ClearContents For Each Archivo In .SelectedItems ConsolidarArchivo Archivo Next Sheets("Hoja1").Activate MsgBox "Carga completada" End If End With End Sub '--------------- Private Sub ConsolidarArchivo(Archivo As Variant) Application.ScreenUpdating = False Application.StatusBar = Archivo With ThisWorkbook.Sheets("Hoja1") Fila = .Range("A" & Rows.Count).End(xlUp).Row + 1 Workbooks.Open Archivo Range("A2:AO" & Range("A" & Rows.Count).End(xlUp).Row).Copy .Range("A" & Fila) End With Application.StatusBar = False ActiveWorkbook.Close End Sub
  19. Si utilizas el nombre del objeto VBA debes hacerlo así: Hoja1.Range("A1")="Hola" Si quieres utilizar el nombre de la hoja debes utilizar el objeto Excel Sheets("Auxiliar").Range("A1")="Hola"
×
×
  • Create New...

Important Information

Privacy Policy