Start a VBA-code aften another VBA-code in another sheet

[KlausW]

Hi all,can some help me to get this VBA code running after another VBA-code when I push a button. The VBA-code to be run is in sheet VPL.

Sub ReNameTab()
Dim NewName As String
Dim OldName As String
Dim Rw As Integer
Rw = Selection.Row  '***Assumes cell within relevant row in VPL will be selected?????

'If A has value, rename Tab B as  A
If Len(Cells(Rw, 1).Text) > 1 Then
    OldName = Cells(Rw, 2)
    NewName = Cells(Rw, 1)
    GoTo DoStuff
Else
'Otherwise If B has value, rename Tab E as B
If Len(Cells(Rw, 2).Text) > 1 Then
    OldName = Cells(Rw, 5)
    NewName = Cells(Rw, 2)
End If
End If

DoStuff:
On Error Resume Next  ' ignore if sheet name cannot be found
'Change tab name
Sheets(OldName).Name = NewName
On Error GoTo 0  ' reset default error handling
End Sub

The VBA code I want it to start after is in a module. I would like to get help to make it run after this VBA code.

Sub Rektangelafrundedehjørner4_Klik()

Dim ws As Worksheet
   Dim wbk As Workbook
   Dim Pth As String, Fname As String
      Pth = Range("m1") 'GetFolder()
      Fname = Dir(Pth & "\*.xls*")
   
   Do While Fname <> ""
     Set wbk = Workbooks.Open(Pth & "\" & Fname)
      For Each ws In wbk.Worksheets
         If Not ShtExists(ws.Name, ThisWorkbook) Then
            ws.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
         End If
      Next ws
      wbk.Close False
      Fname = Dir
   Loop
   
  'Sheets("Fast besætning").Select
Call ReNameTab

End Sub

Any help will be appreciated.
Best regards
Klaus W

 

[Michael M]

you could just call it from the first sub

DoStuff:
On Error Resume Next  ' ignore if sheet name cannot be found
'Change tab name
Sheets(OldName).Name = NewName
On Error GoTo 0  ' reset default error handling
call Rektangelafrundedehjørner4_Klik
End Sub

 

[KlausW]

Hi Michael M, I think I wrote wrong. It is this VBA code that must be the start code.

Sub Rektangelafrundedehjørner4_Klik()

Dim ws As Worksheet
   Dim wbk As Workbook
   Dim Pth As String, Fname As String
      Pth = Range("m1") 'GetFolder()
      Fname = Dir(Pth & "\*.xls*")
   
   Do While Fname <> ""
     Set wbk = Workbooks.Open(Pth & "\" & Fname)
      For Each ws In wbk.Worksheets
         If Not ShtExists(ws.Name, ThisWorkbook) Then
            ws.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
         End If
      Next ws
      wbk.Close False
      Fname = Dir
   Loop
   
  'Sheets("Fast besætning").Select
Call ReNameTab

End Sub

And this is the secound code.

Sub ReNameTab()
Dim NewName As String
Dim OldName As String
Dim Rw As Integer
Rw = Selection.Row  '***Assumes cell within relevant row in VPL will be selected?????

'If A has value, rename Tab B as  A
If Len(Cells(Rw, 1).Text) > 1 Then
    OldName = Cells(Rw, 2)
    NewName = Cells(Rw, 1)
    GoTo DoStuff
Else
'Otherwise If B has value, rename Tab E as B
If Len(Cells(Rw, 2).Text) > 1 Then
    OldName = Cells(Rw, 5)
    NewName = Cells(Rw, 2)
End If
End If

DoStuff:
On Error Resume Next  ' ignore if sheet name cannot be found
'Change tab name
Sheets(OldName).Name = NewName
On Error GoTo 0  ' reset default error handling
End Sub

Both codes are in sheet VPL.

Klaus W

 

[Michael M]

Ok, so I note you have change the call line ...is it working now ???

 

[Alex Blakenburg]

It doesn't make any sense to run the rename macro after a macro that copies a number of workbooks an worksheets into the current workbook.
The rename macro relies on ONE row being selected in the sheet that contains the code. That seems to bear no relationship to what the other macro is doing.
If you do want to go ahead then in the Rektangelafrundedehjørner4_Klik module your Call ReNameTab looks correct but in the ReName macro you will need to add the line in Blue.

    Me.Select
    Rw = Selection.Row  '***Assumes cell within relevant row in VPL will be selected?????

 

[KlausW]

Ok, so I note you have change the call line ...is it working now ???

No it do not