Excel VBA - save as file with content from a specific sheet - vba

Question

I'm trying to save as my Excel file into multiple xlsx files, soemthing like this:
I would like to save as it into multiple xlsx files with each file will content 1 line range("Ax:Dx"). I have written the code as below to do that
Sub split_file()
Dim wb As Workbook
Dim ws As Worksheet
Dim i As Long
Dim lastrow1 As Long
Dim lastrow2 As Long
Set wb = ThisWorkbook
On Error Resume Next
'Dim filename As String
Path = "C:\test"
For i = 2 To Sheet2.Range("A" & Rows.Count).End(xlUp).Row
'wb.Worksheets(3).Copy 'create new active workbook
Sheets.Add.Name = Sheet2.Range("A" & i).Value
With Worksheets(Sheet2.Range("A" & i).Value)
Range("A1:D1").Value = Sheet2.Range("A" & i & ":D" & i).Value
.SaveAs filename:=Path & "\" & Sheet2.Range("A" & i).Value, FileFormat:=xlOpenXMLWorkbook, Password:="Welcome1"
.Close savechanges:=False
End With
Next i
On Error GoTo 0
End Sub
The result I got is shown in this screenshot:
Once I open the file after save as with proper data, it include some unwanted sheets in that :( .
Like this:
I wish it save as only the file with the same name. Can anybody help look for this problem ?
Very appreciated for each support of you all.

Answer 1

Please, try the next way:
Sub split_file()
Dim wb As Workbook, ws As Worksheet, wsNew As Worksheet, wbNew As Workbook
Dim path As String, i As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets(Sheet2.Name)
path = "C:\test"
For i = 2 To ws.Range("A" & rows.count).End(xlUp).row
Set wbNew = Workbooks.Add(xlWBATWorksheet)
Set wsNew = wbNew.Sheets(1): wsNew.Name = ws.Range("A" & i).value
wsNew.Range("A1:D1").value = ws.Range("A" & i & ":D" & i).value
wbNew.saveas FileName:=path & "\" & wsNew.Name, FileFormat:=xlOpenXMLWorkbook, password:="Welcome1"
wbNew.Close savechanges:=False
Next i
End Sub
I assumed that Sheet2 is a code name...