How to make my worksheets into workbooks in a designated folder?

[Bonbi456]

Hi people,

The code I currently have is fully functionning, however I would like to add a feature that takes each worksheet that starts with MW and makes it into a workbook that is then saved on a folder that I've made ( the path is C:\Users\(MYNAME)\Desktop\VBAWorkbookTest). Ideally, the workbooks would keep the same name as the worksheets and override the older workbooks when the program is run multiple times.

I've tried figuring it out with research but I can't figure it out for the life of me, everything I add comes with error so I removed my previous, unsuccessful attempts from the code you see below:

Sub AutomationStep1()
  Dim Cl As Range, Rng As Range
  Dim Cl2 As Range, Rng2 As Range
  Dim Cl3 As Range, Rng3 As Range
  Dim c As Range
  Dim Cl4 As Range, Rng4 As Range
  Dim Lastrow As Long
  Dim ws As Worksheet
  Dim wb As Workbook
  
  For Each ws In ActiveWorkbook.Worksheets
    Set Rng = Nothing                     
    Set Rng2 = Nothing                    
    Set Rng3 = Nothing                    
    Set Rng4 = Nothing                    
    If ws.Name Like "MW*" Then
    
      For Each Cl In ws.Range("A1:J1")   
        Select Case Cl.Value
          Case "#", "Coupler Detached", "Coupler Attached", "Host Connected", "End Of File", "ms"
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
        End Select
      Next Cl
      If Not Rng Is Nothing Then Rng.EntireColumn.Delete
      
      For Each Cl4 In ws.Range("D1")
        Select Case Cl4.Value
          Case "Abs Pres (kPa) c:1 2"
              If Rng4 Is Nothing Then Set Rng4 = Cl4 Else Set Rng4 = Union(Rng4, Cl4)
        End Select
      Next Cl4
      If Not Rng4 Is Nothing Then
        Lastrow = ws.Cells(Rows.Count, "D").End(xlUp).Row
        For Each c In ws.Range("D2:D" & Lastrow)
          c.Value = c.Value * 0.101972
        Next
      End If

      For Each Cl2 In ws.Range("A1:J1")
        Select Case Cl2.Value
        Case "Abs Pres (kPa) c:1 2"
          If Rng2 Is Nothing Then Set Rng2 = Cl2 Else Set Rng = Union(Rng, Cl2)
        End Select
      Next Cl2
      If Not Rng2 Is Nothing Then Rng2.Value = ("LEVEL")

      For Each Cl3 In ws.Range("A1:J1")
        Select Case Cl3.Value
        Case "Temp (°C) c:2"
          If Rng3 Is Nothing Then Set Rng3 = Cl3 Else Set Rng = Union(Rng, Cl3)
        End Select
      Next Cl3
      If Not Rng3 Is Nothing Then Rng3.Value = ("TEMPERATURE")
    End If
  Next ws
End Sub

Any help is greatly appreciated!

 

[Herakles]

This may simplify what you are doing.

Public Sub subCreateWorkbooks()
Dim Ws As Worksheet
Dim strPath As String
Dim WbMaster As Workbook

    Set WbMaster = ActiveWorkbook

    strPath = "C:\Users\(MYNAME)\Desktop\VBAWorkbookTest\"
    
    Application.ScreenUpdating = False
    
    For Each Ws In WbMaster.Worksheets
        
        If Ws.Name Like "MW*" Then
            
            If Dir(strPath & Ws.Name & ".xlsx") <> "" Then
                Kill (strPath & Ws.Name & ".xlsx")
            End If
            
            Ws.Copy
            ActiveWorkbook.SaveAs Filename:=strPath & Ws.Name
            ActiveWorkbook.Close
            
        End If
        
    Next Ws
    
    Application.ScreenUpdating = True
    
End Sub