https://www.mrexcel.com/board/threads/need-message-box-to-display-cell-or-range-of-cells-selected.303592/
Sub audiencia()
'
' audiencia Macro
'
' Acceso directo: CTRL+w
'
'https://blog.excelforo.com/2014/05/vba-diferencias-entre-usedrange-y.html
'https://www.mrexcel.com/board/threads/need-message-box-to-display-cell-or-range-of-cells-selected.303592/
'https://www.excel-avanzado.com/7687/compacion-entre-range-y-cells.html
'http://elsabiodeexcel.blogspot.com/2018/05/hojas-de-trabajo-worksheets-vs-hojas-sheets-VBA.html
'https://excelchamps.com/vba/activate-workbook/
'https://www.mrexcel.com/board/threads/need-message-box-to-display-cell-or-range-of-cells-selected.303592/
'MsgBox "You have highlighted cell " & Selection.Address
'https://www.mrexcel.com/board/threads/need-message-box-to-display-cell-or-range-of-cells-selected.303592/
'Dim indCell As Range
'For Each indCell In Selection
' MsgBox indCell.Address & " " & indCell.Value
'Next indCell
'https://www.mrexcel.com/board/threads/need-message-box-to-display-cell-or-range-of-cells-selected.303592/
'MsgBox "Left column =" & vbTab & Selection.Column & vbCrLf & _
' "Columns selected =" & vbTab & Selection.Columns.Count & vbCrLf & _
' "Top row =" & vbTab & Selection.Row & vbCrLf & _
' "Rows selected = " & vbTab & Selection.Rows.Count
Dim lC As Integer, nC As Integer, lR As Integer, nR As Integer
lC = Selection.Column
nC = Selection.Columns.Count
lR = Selection.Row
nR = Selection.Rows.Count
'limpiar la hoja de destino
Workbooks("audiencias_1.xlsm").Worksheets("Hoja2").Cells.Clear
Range(Cells(lR, lC), Cells(lR + nR - 1, lC + nC - 1)).Copy Destination:=Workbooks("audiencias_1.xlsm").Sheets("Hoja2").Range("A1")
Dim lRR As Integer, lCC As Integer
lRR = 1
lCC = 1
'https://excelchamps.com/vba/activate-workbook/
Workbooks("audiencias_1.xlsm").Activate
Sheets("Hoja2").Activate
Sheets("Hoja2").Range(Cells(lRR, lCC), Cells(lRR + nR - 1, lCC + nC - 1)).Select
'Range("A1:J15").Select
ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Add Key:=Range(Cells(lRR, lCC + 1), Cells(lRR + nR - 1, lCC + 1)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Add Key:=Range(Cells(lRR, lCC + 2), Cells(lRR + nR - 1, lCC + 2)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hoja2").Sort
.SetRange Range("A1:J15")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'dividir
Range(Cells(lRR, lCC + 9), Cells(lRR + nR - 1, lCC + 9)).Select
Selection.TextToColumns Destination:=Range(Cells(lRR, lCC + 9), Cells(lRR, lCC + 9)), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
'interno
Range(Cells(lRR, lCC + 9), Cells(lRR + nR - 1, lCC + 9)).Select
Selection.Copy
Range(Cells(lRR, lCC + 4), Cells(lRR, lCC + 4)).Select
ActiveSheet.Paste
'pasar temporalmente la columna de la corte solicitante
Range(Cells(lRR, lCC + 5), Cells(lRR + nR - 1, lCC + 5)).Select
Selection.Copy
Range(Cells(lRR, lCC + 7), Cells(lRR, lCC + 7)).Select
ActiveSheet.Paste
'colocar en la columna correcta la sala
Range(Cells(lRR, lCC + 6), Cells(lRR + nR - 1, lCC + 6)).Select
Selection.Copy
Range(Cells(lRR, lCC + 5), Cells(lRR, lCC + 5)).Select
ActiveSheet.Paste
'colocar en la columna correcta la corte solicitante
Range(Cells(lRR, lCC + 7), Cells(lRR + nR - 1, lCC + 7)).Select
Selection.Copy
Range(Cells(lRR, lCC + 6), Cells(lRR, lCC + 6)).Select
ActiveSheet.Paste
Range(Cells(lRR, lCC + 10), Cells(lRR + nR - 1, lCC + 10)).Select
Application.CutCopyMode = False
Selection.Copy
Range(Cells(lRR, lCC + 7), Cells(lRR, lCC + 7)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'a mayusculas el texto
Range(Cells(lRR, lCC + 4), Cells(lRR + nR - 1, lCC + 7)).Select
Dim Rng As Range
For Each Rng In Selection.Cells
If Rng.HasFormula = False Then
Rng.Value = UCase(Rng.Value)
End If
Next Rng
'alinear a la derecha la fecha
Range(Cells(lRR, lCC + 2), Cells(lRR + nR - 1, lCC + 3)).Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Dim i As Integer
i = 1
For Each cell In Range(Cells(lRR, lCC), Cells(lRR + nR - 1, lCC))
cell.Value = i
i = i + 1
Next cell
Columns("I:AGX").Select
Range("J1").Activate
Selection.Delete Shift:=xlToLeft
End Sub
