VBA to copy sheet as a new workbook

[atinderjaggi]

hi there, i have a code which was given to me by a member here itself. This code goes through a loop and saves the file as a pdf. instead of saving as a pdf i would like to copy that sheet (tab) and save it as a new excel file. any help is appreciated

Option Explicit

Sub createpdf3()

Dim rng As Range
Dim dataValidationArray As Variant
Dim i As Integer
Dim rows As Integer

Set rng = Sheets("Sheet3").Range("C7")

'If Data Validation list is not a range, ignore errors
On Error Resume Next

rows = Range(Replace(rng.Validation.Formula1, "=", "")).rows.Count
ReDim dataValidationArray(1 To rows)

For i = 1 To rows
dataValidationArray(i) = _
Range(Replace(rng.Validation.Formula1, "=", "")).Cells(i, 1)
Next i


'If not a range, then try splitting a string
If Err.Number <> 0 Then
Err.Clear
dataValidationArray = Split(rng.Validation.Formula1, ",")
End If

'Some other error has occured so exit sub
If Err.Number <> 0 Then Exit Sub

'Reinstate error checking
On Error GoTo 0

'Loop through all the values in the Data Validation Array
For i = LBound(dataValidationArray) To UBound(dataValidationArray)

'Change the value in the data validation cell
rng.Value = dataValidationArray(i)

'Force the sheet to recalculate
Application.Calculate

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, Filename:="C:\Users\sobyvinnie\OneDrive\Desktop\Macro Test " & rng.Value & ".pdf", IgnorePrintAreas:=False, OpenAfterPublish:=False

Next i

End Sub

 

[JEC]

This is the way

Sub jec()
  With ThisWorkbook
    .Sheets(1).Copy
    ActiveWorkbook.SaveAs .Path & "\" & "blablabla", 51
  End With
End Sub

 

[atinderjaggi]

Thank you for your response but the formula is not working perfectly.
a) I need it to be saved to a specific path
b) I would like to save Sheet3 which is defined in my formula above but your vba is saving the first tab of my sheet.
c) I would like the range ID to be the file name

Thanks

 

[johnnyL]

See if this code works for you:

    Dim FName   As String
    Dim FPath   As String
    Dim NewBook As Workbook
 '
    FName = rng.Value & ".xlsx"                                     ' Set New workbook name
    FPath = "C:\Users\sobyvinnie\OneDrive\Desktop\Macro Test\"      ' Set path to save New workbook into
 '
    Set NewBook = Workbooks.Add                                     ' Open a new workbook
 '
    ThisWorkbook.Sheets(rng.Value).Copy Before:=NewBook.Sheets(1)   ' Copy sheet to New workbook
 
    If Dir(FPath & FName) <> "" Then                                ' Check to see if new workbook name already exists
        MsgBox "File " & FPath & FName & " already exists"          '   If it does, display message
    Else                                                            '   Else
        NewBook.SaveAs Filename:=FPath & FName                      '   Save the New workbook
    End If

 

[JEC]

Yes, it was an example. You have to adapt the code