Ejecutar correctamente una Macro de excel
Tengo la siguiente macro: que tras una actualización ya no corre. Quiero que me colaboren con el apoyo necesario para corregir el error.
Macro
Sub Crea_Libros()
'
' Crea libros a partir del MASTER y revisando la lista de SELECCION
' Libros utilizados: 1 - MASTER 2 - SELECCION 3 - NUEVO
'
Dim master, seleccion, ruta, nombre, archivo As String
Dim fila, columna, hoja, indice, limite As Long
Dim nuevo As Integer
ruta = "D:\documentos\transturin\tarifarios\"
master = "MASTER 2016.xls"
seleccion = "SELECCION 2016.xls"
nuevo = 3 'número de libro nuevo
limite = 12 'número límite de columna para revisar en la selección
Workbooks.Open (ruta & seleccion) 'abrir archivo de selección
For columna = 1 To limite
Workbooks.Add 'crear nuevo libro, el 3
indice = 0
Windows(master).Activate
Range("A1").Select
For hoja = 1 To Sheets.Count 'verificar todas las hojas del libro
Sheets(hoja).Activate 'activar hoja correspondiente
Windows(seleccion).Activate 'activar libro
Range("A1").Select
' archivo = Format(Cells(1, columna).Value, "00") & " - (" & Format(Date, "yyyy-mm-dd") & ")" 'rescatar el nombre de la primera fila
archivo = Format(Cells(1, columna).Value, "00") & " - 2016" 'rescatar el nombre de la primera fila
For fila = 2 To 22 'comienza en 2 porque la primera fila es titulo, 20 es el limite actual
nombre = Cells(fila, columna).Value 'obtener valor de la celda actual
Windows(master).Activate
If UCase(nombre) = UCase(Sheets(hoja).Name) Then 'verificar nombre
Cells.Select 'marcar celdas a copiar
Selection.Copy 'copiar lo marcado
Range("A1").Select 'elegir la primera celda
Windows(nuevo).Activate
indice = indice + 1
If Sheets.Count < indice Then 'verificar cantidad de hojas disponibles
Sheets.Add after:=Sheets(indice - 1) 'adicionar una nueva hoja al final de todas
End If
Sheets(indice).Activate 'activar hoja correspondiente
Range("A1").Select 'elegir la primera celda
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste 'pegar datos copiados
Sheets(indice).Name = nombre 'copiar nombre de hoja
'--------------- copiar formatos ---------------
With ActiveSheet.PageSetup
.PrintTitleRows = Windows(master).ActiveSheet.PageSetup.PrintTitleRows
.PrintTitleColumns = Windows(master).ActiveSheet.PageSetup.PrintTitleColumns
.PrintArea = Windows(master).ActiveSheet.PageSetup.PrintArea
.LeftHeader = Windows(master).ActiveSheet.PageSetup.LeftHeader
.CenterHeader = Windows(master).ActiveSheet.PageSetup.CenterHeader
.RightHeader = Windows(master).ActiveSheet.PageSetup.RightHeader
.LeftFooter = Windows(master).ActiveSheet.PageSetup.LeftFooter
.CenterFooter = Windows(master).ActiveSheet.PageSetup.CenterFooter
.RightFooter = Windows(master).ActiveSheet.PageSetup.RightFooter
.LeftMargin = Windows(master).ActiveSheet.PageSetup.LeftMargin
.RightMargin = Windows(master).ActiveSheet.PageSetup.RightMargin
.TopMargin = Windows(master).ActiveSheet.PageSetup.TopMargin
.BottomMargin = Windows(master).ActiveSheet.PageSetup.BottomMargin
.HeaderMargin = Windows(master).ActiveSheet.PageSetup.HeaderMargin
.FooterMargin = Windows(master).ActiveSheet.PageSetup.FooterMargin
.PrintHeadings = Windows(master).ActiveSheet.PageSetup.PrintHeadings
.PrintGridlines = Windows(master).ActiveSheet.PageSetup.PrintGridlines
.PrintComments = Windows(master).ActiveSheet.PageSetup.PrintComments
.CenterHorizontally = Windows(master).ActiveSheet.PageSetup.CenterHorizontally
.CenterVertically = Windows(master).ActiveSheet.PageSetup.CenterVertically
.Orientation = Windows(master).ActiveSheet.PageSetup.Orientation
.Draft = Windows(master).ActiveSheet.PageSetup.Draft
.PaperSize = Windows(master).ActiveSheet.PageSetup.PaperSize
.FirstPageNumber = Windows(master).ActiveSheet.PageSetup.FirstPageNumber
.Order = Windows(master).ActiveSheet.PageSetup.Order
.BlackAndWhite = Windows(master).ActiveSheet.PageSetup.BlackAndWhite
.Zoom = Windows(master).ActiveSheet.PageSetup.Zoom
End With
'--------------- fin copiar formatos ---------------
Range("A1").Select 'elegir la primera celda
End If
Windows(seleccion).Activate
Next
Windows(master).Activate
Range("A1").Select 'elegir la primera celda
Next
Application.DisplayAlerts = False
Windows(nuevo).Activate
ActiveWorkbook.SaveAs Filename:="D:\documentos\transturin\TARIFAS" \ " & archivo ', FileFormat:=xlWorkbookDefault, CreateBackup:=False, ConflictResolution:=2 'grabar el archivo nuevo en formato actual"
' ActiveWorkbook.SaveAs Filename:=ruta & archivo, FileFormat:=xlExcel8, CreateBackup:=False, ConflictResolution:=2 'grabar el archivo nuevo en formato Office 2003
Windows(archivo & ".xlsx").Close 'cerrar libro
Application.DisplayAlerts = True
Next
Windows(master).Activate
Range("A1").Select
Windows(seleccion).Close 'cerrar libro
MsgBox "Se terminó la copia de datos"
End Sub
