Macro seleccionar rango

Hola buenas,
No se si sera posible realizar lo que propongo, lo que necesito es una macro, que me abra un cuadro de dialago y yo le inque un numero de celdas y con ese numero de celdas desde la celda activa en la columna A, E y F. A partir de ahí creo que me las podría arreglar, poner esa selección en color diferente cada vez que se indique un numero y copiarlo a otro libro.
Ahora mismo hago este proceso pero para cada doscientas 200, con un comando diferente siempre.
Un saludo y gracias a quien se anime a probar

1 Respuesta

Respuesta
1
Entiendo que no quieres algo demasiado elaborado (formularios, cajas de texto, botones,...) porque es para un proceso tuyo repetitivo, no para que lo usen otros.
Yo utilizaría un MSGBOX(), recogiendo el resultado en una variable, validando que el número que capturas es correcto. Con el número de celdas, construiría el rango y luego un select del mismo, para seleccionar el rango, copiarlo al portapeles, cambiarlo de color, ir al otro libro y pegarlo.
Lo que no comprendo es el criterio de selección del rango. Hablas de la scolumnas A, E y F y la celda activa, pero no lo entiendo.
Espero que te valga con lo anterior. Si quieres que intente hacer la macro, dímelo.
Hola,
Gracias por la ayuda, mira los datos que necesito están en esas columnas porque vienen así organizados. Es tipo un listín telefónico y yo solo necesito las columnas de nombre, provincia y teléfono, entonces lo que necesito es coger bloques de 200 registros y exportarlos a otra hoja nueva. Al mismo tiempo lo que hago es colorear los registros que cojo para no liarme la siguiente. Ahora mismo lo tengo hecho individualmente, te pongo aquí 2 macros para que veas, una es para coger 200 registros y la otra para coger del 200 al 400 y del 400 al 600.
Sub macro200()
'
' macro200 Macro
' Macro grabada el 29/04/2010 por XP BlackCrystalT v8
'
' Acceso directo: CTRL+a
'
    Range("E2:F200,A2:A200").Select
    Range("A2").Activate
    With Selection.Interior
        .ColorIndex = 38
        .Pattern = xlSolid
    End With
    Selection.Copy
    Sheets("Hoja1").Select
    Range("D2").Select
    ActiveSheet.Paste
    Selection.Interior.ColorIndex = xlNone
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Sheets("Hoja1").Select
    Sheets("Hoja1").Copy
    Windows("prueba.xls").Activate
    Selection.ClearContents
    Sheets("Hoja2").Select
    ActiveWindow.SmallScroll Down:=180
    Range("A201").Select
End Sub
Sub Macro400()
'
' Macro400 Macro
' Macro grabada el 29/04/2010 por XP BlackCrystalT v8
'
' Acceso directo: CTRL+s
'
    Range("A201:A400,E201:F400").Select
    Range("E400").Activate
    With Selection.Interior
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
    Selection.Copy
    Sheets("Hoja1").Select
    Range("D2").Select
    ActiveSheet.Paste
    Selection.Interior.ColorIndex = xlNone
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Sheets("Hoja1").Select
    Sheets("Hoja1").Copy
    Windows("prueba.xls").Activate
    Selection.ClearContents
    Sheets("Hoja2").Select
    Range("A401").Select
End Sub
Sub Macro600()
' Macro600 Macro
' Macro grabada el 29/04/2010 por XP BlackCrystalT v8
'
' Acceso directo: CTRL+d
'
    Range("A401:A600,E401:F600").Select
    Range("E600").Activate
    With Selection.Interior
        .ColorIndex = 36
        .Pattern = xlSolid
    End With
    Selection.Copy
    Sheets("Hoja1").Select
    Range("D2").Select
    ActiveSheet.Paste
    Selection.Interior.ColorIndex = xlNone
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Sheets("Hoja1").Select
    Sheets("Hoja1").Copy
    Windows("prueba.xls").Activate
    Selection.ClearContents
    Sheets("Hoja2").Select
    Range("A601").Select
End Sub
No tienen porque ser de 200 registros, precisamente era por lo que quería incorporar "algo", para que yo le indicase cuantos registros tenia que coger y desde que celda.
Buff, vaya rollo, espero que te aclares, sino muchas gracias por la ayuda.
No sé si te valdrá, pero creo que esto te más abajo te podrá ser de ayuda.
Saludos
Angel
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1º Control de Evento de botón derecho del ratón :
Te pide el número de filas a procesar a partir de la fila seleccionada, ofreciéndote por defecto 200. Lo tendrás que poner dentro del código VBA de la hoja que vayas a procesar (creo que es la Hoja2).
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim FilasAProcesar
FilasAProcesar = InputBox("Indica las filas a Procesar desde la fila seleccionada", , 200)
If IsNumeric(FilasAProcesar) And FilasAProcesar > 0 Then
    If ProcesaRango(FilasAProcesar, Target.Row) Then
    End If
End If
End Sub
 
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2º Función ProcesaRango()
La macro que se encarga de procesar el rango a partir de la fila en curso y las filas a procesar. Creo que hace todo lo que hacen tus macros, aunque sin datos es difícil comprobarlo.
Function ProcesaRango(FilasAProcesar, FilaEnCurso)
    FilasAProcesar = Val(FilasAProcesar)
    FilaFinal = FilaEnCurso + FilasAProcesar - 1
    RangoAProcesar = "A" + Trim(Str(FilaEnCurso)) + ":A" + Trim(Str(FilaFinal)) + "," + _
                     "E" + Trim(Str(FilaEnCurso)) + ":F" + Trim(Str(FilaFinal))
    'Range("A401:A600,E401:F600").Select
    Range(RangoAProcesar).Select
    'Range("E600").Activate
    Range("E" + Trim(Str(FilaFinal))).Activate
    With Selection.Interior
        .ColorIndex = 36
        .Pattern = xlSolid
    End With
    Selection.Copy
    Sheets("Hoja1").Select
    Range("D2").Select
    ActiveSheet.Paste
    Selection.Interior.ColorIndex = xlNone
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Sheets("Hoja1").Select
    Sheets("Hoja1").Copy
    Windows("prueba.xls").Activate
    Selection.ClearContents
    Sheets("Hoja2").Select
    'Range("A601").Select
    Range("A" + Trim(Str(FilaFinal + 1))).Select
End Function
Muchas, gracias tío, eres realmente bueno. Solo hay una pequeña pega si es que se puede poner alguna, y es que no se ponga colores en colores diferentes cada vez que se haga una selección.
Un saludo
Pues no es tan complicado:
Function ProcesaRango(FilasAProcesar, FilaEnCurso)
Static conta As Integer
    If conta = Empty Then
        conta = 1
    Else
        conta = conta + 1
    End If

    FilasAProcesar = Val(FilasAProcesar)
    FilaFinal = FilaEnCurso + FilasAProcesar - 1
    RangoAProcesar = "A" + Trim(Str(FilaEnCurso)) + ":A" + Trim(Str(FilaFinal)) + "," + _
                     "E" + Trim(Str(FilaEnCurso)) + ":F" + Trim(Str(FilaFinal))
    'Range("A401:A600,E401:F600").Select
    Range(RangoAProcesar).Select
    'Range("E600").Activate
    Range("E" + Trim(Str(FilaFinal))).Activate
    With Selection.Interior
        .ColorIndex = 36 + conta
        .Pattern = xlSolid
    End With
    Selection.Copy
    Sheets("Hoja1").Select
    Range("D2").Select
    ActiveSheet.Paste
    Selection.Interior.ColorIndex = xlNone
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Sheets("Hoja1").Select
    Sheets("Hoja1").Copy
    Windows("prueba.xls").Activate
    Selection.ClearContents
    Sheets("Hoja2").Select
    'Range("A601").Select
    Range("A" + Trim(Str(FilaFinal + 1))).Select
End Function

Me alegro de que te sirva. Recuerda finalizar la pregunta.
Saludos
Angel

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas