Realizar un proceso sin repetir el código

Buen día a todos,
La consulta es la siguiente, tengo que realizar un proceso en varias columnas de un Excel.
Lo que hice fue el código y lo repetí por cada columna cambiando los valores
de las celdas.
Lo que me gustaría es contar con un solo
"modulo" de código y no tener que repetirlo por cada
columna.
Es posible?
Muchas gracias.

Respuesta
1

¿Posible? Sin duda, SI.

Pon aquí el código y miraré cómo hacerlo.

Muchas gracias

La parte que no quiero se repita la vas a ver enumerada 3 veces.

Cualquier duda me avisas.

Lo que hice fue cambiar la columna de lugar, pero bien podría cambiar las celdas de referencia.

Sub CopiadeDatos()
Windows("time band L a V kids 4-11 julio al 27 de sept.xls").Activate
Range("B4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Macro v1.0.xlsm").Activate
Range("E5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'1
Windows("Programación L a V kids 4-11 julio al 27 de sept.xls").Activate
For Fila = 1 To 91
If Cells(Fila, 4).Value = "" Then
Rows(Fila).EntireRow.Hidden = True
End If
Next Fila
Range("B3:C91").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Pay_P04-11").Select
Sheets.Add
ActiveSheet.Name = "Test"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$B$54").RemoveDuplicates Columns:=1, Header:=xlNo
Selection.Copy
Windows("Macro v1.0.xlsm").Activate
Range("J5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Programación L a V kids 4-11 julio al 27 de sept.xls").Activate
Cells.Select
Selection.EntireRow.Hidden = False
Sheets("Test").Select
ActiveWindow.SelectedSheets.Delete
'2
Windows("Programación L a V kids 4-11 julio al 27 de sept.xls").Activate
Columns("D:D").Select
Selection.Cut
Range("G1").Select
ActiveSheet.Paste
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
For Fila = 1 To 91
If Cells(Fila, 5).Value = "" Then
Rows(Fila).EntireRow.Hidden = True
End If
Next Fila
Range("B3:C91").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Pay_P04-11").Select
Sheets.Add
ActiveSheet.Name = "Test"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$B$54").RemoveDuplicates Columns:=1, Header:=xlNo
Selection.Copy
Windows("Macro v1.0.xlsm").Activate
Range("L5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Programación L a V kids 4-11 julio al 27 de sept.xls").Activate
Cells.Select
Selection.EntireRow.Hidden = False
Sheets("Test").Select
ActiveWindow.SelectedSheets.Delete
'3
Windows("Programación L a V kids 4-11 julio al 27 de sept.xls").Activate
Columns("D:D").Select
Selection.Cut
Range("G1").Select
ActiveSheet.Paste
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
For Fila = 1 To 91
If Cells(Fila, 5).Value = "" Then
Rows(Fila).EntireRow.Hidden = True
End If
Next Fila
Range("B3:C91").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Pay_P04-11").Select
Sheets.Add
ActiveSheet.Name = "Test"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$B$54").RemoveDuplicates Columns:=1, Header:=xlNo
Selection.Copy
Windows("Macro v1.0.xlsm").Activate
Range("N5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Programación L a V kids 4-11 julio al 27 de sept.xls").Activate
Cells.Select
Selection.EntireRow.Hidden = False
Sheets("Test").Select
ActiveWindow.SelectedSheets.Delete
Columns("D:D").Select
Selection.Cut
Range("G1").Select
ActiveSheet.Paste
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Windows("Macro v1.0.xlsm").Activate
Rows("44:225").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveWorkbook.Sabe
End Sub

Tengo la impresión que tienes una parte que se repite y otra parte que no. La repetitiva la podemos sacar a un subproceso al cual pasaremos unos parámetros. Lo que no se repite tendrá que seguir donde está.

Te mando algo que puede ir sirviendo de ejemplo.

Sub llamadasAlProceso()
Dim mi nombre As String
mi nombre = ThisWorkbook.Name
' Activa el otro libro y copia de B4 hasta el final de la página
' En este caso lo seleccionaremos y pasaremos como rango
Windows(nomLibro).Activate
Range("B4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
' Lo primero que hace es copiar los datos a la celda indicada E5 de este libro
Selection.Copy
Windows(mi nombre).Activate
Range("E5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
' Esta es la parte que veo como repetitiva, por eso la saco a un 'sub'
' con los parámetros necesarios
macroConParametros mi nombre, nomLibro, "J5"
' **********************
' *** SEGUNDA PASADA ***
' **********************
' Antes de ejecutar la segunda vez, usando como rango la columna D,
' el proceso corta los datos de la columna "D" y los copia en "G"
' (no entiendo qué se hace pero eso es lo que interpreto del código)
' En el libro de datos (ya estaba activo)
Windows(nomLibro).Activate
' Cortamos toda la columna "D" y la pegamos en la "G"
Columns("D:D").Cut
Range("G1").Select
ActiveSheet.Paste
' Borramos lo que hay ahora en la columna "D"
Columns("D:D").Delete Shift:=xlToLeft
' Llamamos al proceso indicando la nueva celda de destino
macroConParametros mi nombre, nomLibro, "L5"
' **********************
' *** TERCERA PASADA ***
' **********************
Windows(nomLibro).Activate
Columns("D:D").Cut
Range("G1").Select
ActiveSheet.Paste
Columns("D:D").Delete Shift:=xlToLeft
' Llamamos al proceso indicando la nueva celda de destino
macroConParametros mi nombre, nomLibro, "N5"
...
...
... resto de código ...
...
...
End Sub

Sub macroConParametros(ByVal mi nombre As String, ByVal nomOtroLibro As String, _
ByVal celdaDestinoDatosFinales As String)
Dim Fila As Integer
' En el libro que parece tener los datos
Windows(nomOtroLibro).Activate
' Oculta las filas que no tienen nada en la columna "D"
For Fila = 1 To 91
If Cells(Fila, 4).Value = "" Then
Rows(Fila).EntireRow.Hidden = True
End If
Next Fila
' Copia las celdas visibles del rango indicado
Range("B3:C91").SpecialCells(xlCellTypeVisible).Copy
' Crea una nueva página y pega los valores copiados en ella
Sheets("Pay_P04-11").Select
Sheets.Add
ActiveSheet.Name = "Test"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
' Borra los valores duplicados y copia los que quedan
ActiveSheet.Range("$A$1:$B$54").RemoveDuplicates Columns:=1, Header:=xlNo
Selection.Copy
' Activa el libro de macros y pega los datos copiados a partir de la
' celda que nos han dicho que es la de salida
Windows(mi nombre).Activate
Range("J5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
' Volvemos al libro de datos y desocultamos todas las filas
Windows(nomOtroLibro).Activate
Cells.Select
Selection.EntireRow.Hidden = False
' Borramos la página "Test"
Sheets("Test").Select
ActiveWindow.SelectedSheets.Delete
End Sub

Al no tener unos datos de ejemplo no puedo ver exactamente lo que hace, pero creo que es lo mismo que la creo que me mandaste.

Creo que lo que necesito, te pido uno días para probarlo.

Desde ya mas que agradecido por tu tiempo, son realmente uno genios.

Abrazo,

Tranquilamente el código y ya me contarás.

Verás que algunas instrucciones que tenías en más de una línea las he unido. Por ejemplo: si seleccionas una celda (o rango) para en la siguiente instrucción usar "selection", se puede simplificar en una única línea quitando el ".select" de la primera y el "selection" de la segunda.

Bueno, ya me contarás si es eso o si tenemos que mirarlo más a fondo.

Me sirvió mucho de referencia de como poder trabajar de forma mas eficiente una macro.

Cualquier duda vuelvo a preguntar.

muchísimas gracias.

Añade tu respuesta

Haz clic para o