I made this sub in VBA which copies the contents of a sheet to a new sheet, then format and save this as a .csv. But when I'm debugging this, the sub jumps alone to a function in another module and starts an infinite loop. Depending on the organization of the commands, it jumps before or after for this function, but always skips. in the current sub is jumping in the ".move" command.
I have not found the solution because the polls always return something like: "How to do a sub automatically call a function?" But that is precisely what is happening to me without my will.
That is my Sub
Sub TCzor()
'
Dim MData, MStr
Dim ultimalinha As Integer
Dim valorA As String
Dim valorB As String
Dim valorC As String
Dim valorD As String
Dim sUserName As String
MData = Date
MStr = Format(MData, "ddmm")
sUserName = Environ$("username")
'
Windows("MultiTrat.xlsm").Activate
Sheets("MultiTrat").Select
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "TCzor"
Sheets("MultiTrat").Select
Range("AX3:BF111").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("TCzor").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveSheet.Range("$A$1:$I$109").AutoFilter Field:=1, Criteria1:="="
Rows("2:2").Select
Range(Selection, Rows("1000:1000")).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("G:G").Select
Selection.Cut
Columns("B:B").Select
ActiveSheet.Paste
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Range(Selection, Columns("XFD:XFD")).Select
Selection.Delete Shift:=xlToLeft
Range("D1").Value = "Valor"
Columns("D:D").Select
Selection.NumberFormat = "0.00"
ultimalinha = Range("A1").End(xlDown).Row
For linha = 2 To ultimalinha
If Cells(linha, 3).Value = "C" Then
Cells(linha, 3).Value = "Créd"
Else
Cells(linha, 3).Value = "Déb"
End If
Next linha
For linha = 1 To ultimalinha
valorA = Cells(linha, 1)
valorB = Cells(linha, 2)
valorC = Cells(linha, 3)
valorD = Cells(linha, 4)
Cells(linha, 1) = valorA & ";" & valorB & ";" & valorC & ";" & valorD
Next linha
Range("B:D").Delete
Sheets("TCzor").Select
Sheets("TCzor").Move
ChDir "C:\Users\" & sUserName & "\Desktop"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\" & sUserName & "\Desktop\TC" & MStr & ".csv", FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWindow.Close
Windows("tczor_jv.xlsm").Activate
End Sub
And this is the Function that it is calling by itself
Function GetARN(Myrange As Range) As String
Dim regex As New RegExp
Dim strPattern As String
Dim strInput As String
Dim strReplace As String
Dim strOutput As String
strPattern = "[0-9]{23}"
strInput = Myrange.Value
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
Set matches = regex.Execute(strInput)
For Each Match In matches
GetARN = Match.Value
Next Match