Macro doesn't start with a button - vba

Question

I'm having an issue while i execute a macro.
When i execute it Line by line it works perfectly (Slow, but perfect).
But when i execute it with a Button in the graphic inteface, it doesn't even open the Excel File that is necessary to run the procedure.
Below i will link my code, because i don't even know what is happening.
I'm thinking that it must be some issue related with the weight of the procedure. But i don't know really.
Thank you by the way.
Sub Estructura_Activo_Fijo()
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wbEstructura As Workbook
Dim wsTAG As Worksheet
Dim xWBName As String
Dim xWb As Workbook
Dim est
Dim consfinal
Dim boc
Dim bct
Dim consoc
On Error Resume Next
xWBName = "Estructura.xlsx"
Set wbEstructura = Application.Workbooks(xWBName)
If wbEstructura Is Nothing Then
Workbooks.Open Filename:=ActiveWorkbook.Path & "\Estructura.xlsx"
End If
On Error Resume Next
xWBName = "Consolidado Final.xlsx"
Set xWb = Application.Workbooks(xWBName)
If xWb Is Nothing Then
Workbooks.Open Filename:=ActiveWorkbook.Path & "\BBDD\Biblioteca\BBDD Locales\Consolidado Final.xlsx"
End If
On Error Resume Next
xWBName = "BBDD OC.xlsx"
Set xWb = Application.Workbooks(xWBName)
On Error Resume Next
If xWb Is Nothing Then
Workbooks.Open Filename:=ActiveWorkbook.Path & "\BBDD OC.xlsx"
End If
On Error Resume Next
xWBName = "BBDD CT.xlsx"
Set xWb = Application.Workbooks(xWBName)
If xWb Is Nothing Then
Workbooks.Open Filename:=ActiveWorkbook.Path & "\BBDD CT.xlsx"
End If
On Error Resume Next
xWBName = "Consolidado OC.xlsx"
Set xWb = Application.Workbooks(xWBName)
If wb Is Nothing Then
Workbooks.Open Filename:=ActiveWorkbook.Path & "\Consolidado OC.xlsx"
End If
ActiveWindow.WindowState = xlMinimized
Set wbEstructura = Workbooks("Estructura.xlsx")
Set wsTAG = wbEstructura.Worksheets("TAG")
Workbooks("Estructura.xlsx").Activate
Dim rng1 As Range, FSO
Dim rngTipo As Range
Dim i As Long
Dim j As Long
Dim k As Long
Dim error As Long
Dim existente As Long
Dim inicioTiempo As Double
Dim minutosTranscurridos As String
Set rng1 = wsTAG.Range("B2")
Set rngTipo = wsTAG.Range("AE2")
Set FSO = CreateObject("Scripting.FileSystemObject")
ruta = ActiveWorkbook.Path
inicioTiempo = Timer
rutaAño = ruta & "\2017"
rutaFARFI = rutaAño & "\FAR_FI"
rutaFARTA = rutaAño & "\FAR_TA"
rutaFARTN = rutaAño & "\FAR_TN"
rutaGOPMTI = rutaAño & "\GOPM_TI"
If Not FSO.FolderExists(rutaAño) Then
MkDir ruta & "\2017"
i = i + 1
Else
existente = existente + 1
MsgBox "La carpeta \2017 ya existe, el proceso se cerrará.", vbCritical
Exit Sub
End If
If Len(Dir(rutaFARFI, vbDirectory)) = 0 Then
MkDir rutaFARFI
Else
existente = existente + 1
End If
If Len(Dir(rutaFARTA, vbDirectory)) = 0 Then
MkDir rutaFARTA
Else
existente = existente + 1
End If
If Len(Dir(rutaFARTN, vbDirectory)) = 0 Then
MkDir rutaFARTN
Else
existente = existente + 1
End If
If Len(Dir(rutaGOPMTI, vbDirectory)) = 0 Then
MkDir rutaGOPMTI
Else
existente = existente + 1
End If
Do While Not IsEmpty(rng1)
If FSO.FolderExists(rutaAño) Then
v = rng1.Offset(0, 29).Value
Do While IsEmpty(rngTipo)
error = error + 1
Set rngTipo = rngTipo.Offset(1, 0)
Loop
If v = "Padre" Then 'Si 'v' es Padre:
If Not FSO.FolderExists(rutaFARFI & "\" & Left(v, 1) & rng1.Value2) Then
FSO.CreateFolder (rutaFARFI & "\" & Left(v, 1) & rng1.Value2)
i = i + 1
padre = padre + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaFARTA & "\" & Left(v, 1) & rng1.Value2) Then
FSO.CreateFolder (rutaFARTA & "\" & Left(v, 1) & rng1.Value2)
i = i + 1
padre = padre + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaFARTN & "\" & Left(v, 1) & rng1.Value2) Then
FSO.CreateFolder (rutaFARTN & "\" & Left(v, 1) & rng1.Value2)
i = i + 1
padre = padre + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaGOPMTI & "\" & Left(v, 1) & rng1.Value2) Then
FSO.CreateFolder (rutaGOPMTI & "\" & Left(v, 1) & rng1.Value2)
i = i + 1
padre = padre + 1
Else
existente = existente + 1
End If
rutaPadreFARFI = rutaFARFI & "\" & Left(v, 1) & rng1.Value
rutaPadreFARTA = rutaFARTA & "\" & Left(v, 1) & rng1.Value
rutaPadreFARTN = rutaFARTN & "\" & Left(v, 1) & rng1.Value
rutaPadreGOPMTI = rutaGOPMTI & "\" & Left(v, 1) & rng1.Value
ElseIf v = "Componente" Then
If Not FSO.FolderExists(rutaPadreFARFI & "\" & Left(v, 1) & rng1.Value) Then
FSO.CreateFolder (rutaPadreFARFI & "\" & Left(v, 1) & rng1.Value)
i = i + 1
componente = componente + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARTA & "\" & Left(v, 1) & rng1.Value) Then
FSO.CreateFolder (rutaPadreFARTA & "\" & Left(v, 1) & rng1.Value)
i = i + 1
componente = componente + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARTN & "\" & Left(v, 1) & rng1.Value) Then
FSO.CreateFolder (rutaPadreFARTN & "\" & Left(v, 1) & rng1.Value)
i = i + 1
componente = componente + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreGOPMTI & "\" & Left(v, 1) & rng1.Value) Then
FSO.CreateFolder (rutaPadreGOPMTI & "\" & Left(v, 1) & rng1.Value)
i = i + 1
componente = componente + 1
Else
existente = existente + 1
End If
rutaCompFARFI = rutaPadreFARFI & "\" & Left(v, 1) & rng1.Value
rutaCompFARTA = rutaPadreFARTA & "\" & Left(v, 1) & rng1.Value
rutaCompFARTN = rutaPadreFARTN & "\" & Left(v, 1) & rng1.Value
rutaCompGOPMTI = rutaPadreGOPMTI & "\" & Left(v, 1) & rng1.Value
End If
w = rng1.Offset(0, 1).Value
If v = "Padre" Then
If Not FSO.FolderExists(rutaPadreFARFI & "\" & w) Then
FSO.CreateFolder (rutaPadreFARFI & "\" & w)
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARFI & "\OC") Then
FSO.CreateFolder (rutaPadreFARFI & "\OC")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARFI & "\EP") Then
FSO.CreateFolder (rutaPadreFARFI & "\EP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARFI & "\CAP") Then
FSO.CreateFolder (rutaPadreFARFI & "\CAP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARTA & "\" & w) Then
FSO.CreateFolder (rutaPadreFARTA & "\" & w)
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARTA & "\OC") Then
FSO.CreateFolder (rutaPadreFARTA & "\OC")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARTA & "\EP") Then
FSO.CreateFolder (rutaPadreFARTA & "\EP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARTA & "\CAP") Then
FSO.CreateFolder (rutaPadreFARTA & "\CAP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARTN & "\" & w) Then
FSO.CreateFolder (rutaPadreFARTN & "\" & w)
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARTN & "\OC") Then
FSO.CreateFolder (rutaPadreFARTN & "\OC")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARTN & "\EP") Then
FSO.CreateFolder (rutaPadreFARTN & "\EP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreFARTN & "\CAP") Then
FSO.CreateFolder (rutaPadreFARTN & "\CAP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreGOPMTI & "\" & w) Then
FSO.CreateFolder (rutaPadreGOPMTI & "\" & w)
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreGOPMTI & "\OC") Then
FSO.CreateFolder (rutaPadreGOPMTI & "\OC")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreGOPMTI & "\EP") Then
FSO.CreateFolder (rutaPadreGOPMTI & "\EP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaPadreGOPMTI & "\CAP") Then
FSO.CreateFolder (rutaPadreGOPMTI & "\CAP")
j = j + 1
Else
existente = existente + 1
End If
ElseIf v = "Componente" Then
If Not FSO.FolderExists(rutaCompFARFI & "\" & w) Then
FSO.CreateFolder (rutaCompFARFI & "\" & w)
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompFARFI & "\OC") Then
FSO.CreateFolder (rutaCompFARFI & "\OC")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompFARFI & "\EP") Then
FSO.CreateFolder (rutaCompFARFI & "\EP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompFARFI & "\CAP") Then
FSO.CreateFolder (rutaCompFARFI & "\CAP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompFARTA & "\" & w) Then
FSO.CreateFolder (rutaCompFARTA & "\" & w)
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompFARTA & "\OC") Then
FSO.CreateFolder (rutaCompFARTA & "\OC")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompFARTA & "\EP") Then
FSO.CreateFolder (rutaCompFARTA & "\EP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompFARTA & "\CAP") Then
FSO.CreateFolder (rutaCompFARTA & "\CAP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompFARTN & "\" & w) Then
FSO.CreateFolder (rutaCompFARTN & "\" & w)
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompFARTN & "\OC") Then
FSO.CreateFolder (rutaCompFARTN & "\OC")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompFARTN & "\EP") Then
FSO.CreateFolder (rutaCompFARTN & "\EP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompFARTN & "\CAP") Then
FSO.CreateFolder (rutaCompFARTN & "\CAP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompGOPMTI & "\" & w) Then
FSO.CreateFolder (rutaCompGOPMTI & "\" & w)
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompGOPMTI & "\OC") Then
FSO.CreateFolder (rutaCompGOPMTI & "\OC")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompGOPMTI & "\EP") Then
FSO.CreateFolder (rutaCompGOPMTI & "\EP")
j = j + 1
Else
existente = existente + 1
End If
If Not FSO.FolderExists(rutaCompGOPMTI & "\CAP") Then
FSO.CreateFolder (rutaCompGOPMTI & "\CAP")
j = j + 1
Else
existente = existente + 1
End If
End If
'-------------------------------------------------------------------'
'---Creación y Asignacion de carpeta para el archivo Excel Padre.---'
'-------------------------------------------------------------------'
Dim fi, tb As String
Dim TabName As String
TabName = rng1.Value
rutaFichas = ActiveWorkbook.Path & "\BBDD\Fichas SGM"
If v = "Padre" Then
If rutaPadreFARFI = rutaFARFI & "\" & "P" & TabName Then
fi = "FAR - FIN.xlsm"
Workbooks.Open Filename:=rutaFichas & "\" & fi
Range("D5").Value = TabName
ActiveSheet.Name = TabName
With ThisWorkbook
.Worksheets(TabName).Copy
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
.Worksheets(TabName).Copy After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
End With
With ThisWorkbook
.Worksheets("Distribucion").Copy
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
.Worksheets("Distribucion").Copy After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=rutaPadreFARFI & "\" & TabName
ActiveWorkbook.Close SaveChanges:=True
k = k + 1
End If
If rutaPadreFARTA = rutaFARTA & "\" & "P" & TabName Then
tb = "FAR - TRIB.xlsm"
Workbooks.Open Filename:=rutaFichas & "\" & tb
Range("D5").Value = TabName
ActiveSheet.Name = TabName
With ThisWorkbook
.Worksheets(TabName).Copy
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
.Worksheets(TabName).Copy After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
End With
With ThisWorkbook
.Worksheets("Distribucion").Copy
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
.Worksheets("Distribucion").Copy After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=rutaPadreFARTA & "\" & TabName
ActiveWorkbook.Close SaveChanges:=True
k = k + 1
End If
If rutaPadreFARTN = rutaFARTN & "\" & "P" & TabName Then
tb = "FAR - TRIB.xlsm"
Workbooks.Open Filename:=rutaFichas & "\" & tb
Range("D5").Value = TabName
ActiveSheet.Name = TabName
With ThisWorkbook
.Worksheets(TabName).Copy
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
.Worksheets(TabName).Copy After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
End With
With ThisWorkbook
.Worksheets("Distribucion").Copy
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
.Worksheets("Distribucion").Copy After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=rutaPadreFARTN & "\" & TabName
ActiveWorkbook.Close SaveChanges:=True
k = k + 1
End If
If rutaPadreGOPMTI = rutaGOPMTI & "\" & "P" & TabName Then
tb = "FAR - TRIB.xlsm"
Workbooks.Open Filename:=rutaFichas & "\" & tb
Range("D5").Value = TabName
ActiveSheet.Name = TabName
With ThisWorkbook
.Worksheets(TabName).Copy
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
.Worksheets(TabName).Copy After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
End With
With ThisWorkbook
.Worksheets("Distribucion").Copy
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
.Worksheets("Distribucion").Copy After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=rutaPadreGOPMTI & "\" & TabName
ActiveWorkbook.Close SaveChanges:=True
k = k + 1
End If
End If
Set rng1 = rng1.Offset(1, 0)
Set rngTipo = rngTipo.Offset(1, 0)
End If
Loop
Workbooks("Consolidado Final.xlsx").Close
Workbooks("Consolidado OC.xlsx").Close
Workbooks("BBDD CT.xlsx").Close
Workbooks("BBDD OC.xlsx").Close
minutosTranscurridos = Format((Timer - inicioTiempo) / 86400, "hh:mm:ss")
Set FSO = Nothing
'Se reactiva la propiedad de actualización.}
Application.ScreenUpdating = True
ActiveWindow.WindowState = xlMaximized 'Se maximiza la ventana para mostrar el menu
End Sub

Answer 1

Here is an example of how you might split your code into useful VBA components. Define "useful" as something that does more work for you than it eats up of your time.
Option Explicit
Sub Estructura_Activo_Fijo()
Dim WbEstructura As Workbook
Dim WbX As Workbook
Application.ScreenUpdating = False
If Not GetWorkbook("Estructura.xlsx", WbEstructura) Then GoTo SideExit
If Not GetWorkbook("BBDD\Biblioteca\BBDD Locales\Consolidado Final.xlsx", WbX) Then GoTo SideExit
SideExit:
Application.ScreenUpdating = True
End Sub
Private Function GetWorkbook(ByVal FilePath As String, _
Wb As Workbook) As Boolean
Dim Sp() As String ' split FilePath
Dim Ffn As String ' Full File Name
Dim Fn As String ' File name
Sp = Split(FilePath, "\")
Fn = Sp(UBound(Sp))
On Error Resume Next
Set Wb = Application.Workbooks(Fn)
If Err.Number = 9 Then ' 9 = Suscript out of range
Ffn = ActiveWorkbook.Path & "\" & FilePath
If Len(Dir(Ffn)) = 0 Then
MsgBox "I couldn't find the file" & vbCr & _
FilePath & vbCr & _
"This task must now be abandoned.", _
vbCritical, "Unable to open workbook"
Else
Set Wb = Workbooks.Open(FileName:=Ffn)
End If
End If
GetWorkbook = Not (Wb Is Nothing)
End Function
In this example, I created one function which opens a workbook. You can call it repeatedly for the many workbooks you need to open. All the work is done in the function. In the main procedure opening two workbooks just takes 2 lines of code.
You will notice that the function can do a much better job by itself than if it were part of the main. It can tell you what went wrong. Moreover, it returns TRUE if the workbook was successfully opened, and your main procedure can take action depending upon that event much easier and more transparently.