Need to copy specific data from active workbook to a new workbook and save the new workbook in a user specified location

[Purple_Squirrel]

Hi,
I am trying to write data contained in a specific range from the active workbook to a new workbook and then the new workbook ought to be saved in a user specified location. I am using the following code:

Dim x As Workbook
Dim y As Workbook
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
TryAgain:
Flname = InputBox("Enter File Name :", "Creating New File...")
MsgBox Len(Flname)
If Flname <> "" Then
Set NewWkbk = Workbooks.Add
ThisWorkbook.Sheets(1).Copy Before:=NewWkbk.Sheets(1)
'ThisWorkbook.Sheets(1).Range("A2:B200").Copy = NewWkbk.Sheets(1).Range("A2:B200")

NewWkbk.SaveAs ThisWorkbook.Path & "" & Flname
If Err.Number = 1004 Then
NewWkbk.Close
MsgBox "File Name Not Valid" & vbCrLf & vbCrLf & "Try Again."
GoTo TryAgain
End If
ActiveWorkbook.Close
End If

I would like to modify this code to copy a specific range from the active workbook instead of the entire contents of the workbook to the new workbook. Any suggestions/help on how to do this would be extremely appreciated. Thank you.
Regards,
Purple

 

[Fluff]

How about

Sub purpleSquirrel()
   Dim Wbk As Workbook
   Dim Fname As String
   Application.ScreenUpdating = False
   
   Set Wbk = Workbooks.Add
   ThisWorkbook.Sheets(1).Range("A2:B200").Copy Wbk.Sheets(1).Range("A2:B200")
   Fname = Application.GetSaveAsFilename
   
   Wbk.SaveAs Fname, 51
   Wbk.Close
End Sub

 

[Purple_Squirrel]

How about

Sub purpleSquirrel()
   Dim Wbk As Workbook
   Dim Fname As String
   Application.ScreenUpdating = False
   
   Set Wbk = Workbooks.Add
   ThisWorkbook.Sheets(1).Range("A2:B200").Copy Wbk.Sheets(1).Range("A2:B200")
   Fname = Application.GetSaveAsFilename
   
   Wbk.SaveAs Fname, 51
   Wbk.Close
End Sub

Dear Fluff, Thank you for your prompt response. I tried this and it's working well:

Sub purpleSquirrel()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
TryAgain:
Flname = InputBox("Enter File Name :", "Creating New File...")
MsgBox Len(Flname)
If Flname <> "" Then
Set NewWkbk = Workbooks.Add


ThisWorkbook.Sheets(1).Range("A2:C200").Copy
ActiveWorkbook.Sheets(1).Range("A2:C200").PasteSpecial



NewWkbk.SaveAs ThisWorkbook.Path & "" & Flname
If Err.Number = 1004 Then
NewWkbk.Close
MsgBox "File Name Not Valid" & vbCrLf & vbCrLf & "Try Again."
GoTo TryAgain
End If
ActiveWorkbook.Close
End If

End Sub

Thank you.
Best regards,
Purple Squirrel

 

[Fluff]

You're welcome & thanks for the feedback