saving sheets from a new workbook excel - excel

Question

i have an issue with this code. I need to save the data from a workbook to a new workbook but the new workbook doesn't save, I do it manually. I need it to save automatically. Any idea what is going on?
this is my code so far
Private Sub CommandButton3_Click()
Dim wb As Workbook
Dim wb_New As Workbook
Set wb = ThisWorkbook
Dim wbstring As String
Dim input_file_name As String
input_file_name = InputBox("Enter file name", "Enter new workbook file name")
wbstring = "C:\PIME\\"
Workbooks.Add.SaveAs Filename:=wbstring & input_file_name & ".xls", FileFormat:=56
Set wb_New = ActiveWorkbook
wb_New.Worksheets("Sheet1").Range("A1:I2000").Value = wb.Worksheets("NUMB").Range("A1:I2000").Value
End Sub

Answer 1

You got it almost right - Set wb_New to the new workbook, populate the data then use SaveAs method.
Set wb_New = Workbooks.Add
wb_New.Worksheets("Sheet1").Range("A1:I2000").Value = wb.Worksheets("NUMB").Range("A1:I2000").Value
wb_New.SaveAs Filename:=wbstring & input_file_name & ".xls", FileFormat:=56

Answer 2

Copy a Range to a New One-Worksheet Workbook
The only mistake I could find was that you need to remove one of the two trailing backslashes from the path:
wbstring = "C:\PIME\"
An Improvement
Option Explicit
Private Sub CommandButton3_Click()
' Source
Dim swb As Workbook: Set swb = ThisWorkbook
Dim sws As Worksheet: Set sws = swb.Worksheets("NUMB")
' Destination
Dim dFolderPath As String: dFolderPath = "C:\PIME\"
If Right(dFolderPath, 1) <> "\" Then dFolderPath = dFolderPath & "\"
Dim dExtension As String: dExtension = ".xls"
If Left(dExtension, 1) <> "." Then dExtension = "." & dExtension
If Len(Dir(dFolderPath, vbDirectory)) = 0 Then
MsgBox "The path '" & dFolderPath & "' doesn't exist.", vbCritical
Exit Sub
End If
Dim dFileName As String
dFileName = InputBox("Enter file name", "Enter new workbook file name")
If Len(dFileName) = 0 Then
MsgBox "Canceled or no entry."
Exit Sub
End If
Dim dwb As Workbook: Set dwb = Workbooks.Add(xlWBATWorksheet) ' single...
Dim dws As Worksheet: Set dws = dwb.Worksheets(1) ' ... worksheet,...
' ... in another language it may not be 'Sheet1'.
' Copy by Assignement (the most efficient way to copy only values)
dws.Range("A1:I2000").Value = sws.Range("A1:I2000").Value
' Save(As)
Dim dFilePath As String: dFilePath = dFolderPath & dFileName & dExtension
Dim ErrNum As Long
Application.DisplayAlerts = False ' overwrite without confirmation
On Error Resume Next
dwb.SaveAs Filename:=dFilePath, FileFormat:=xlExcel8 ' or 56
ErrNum = Err.Number
On Error GoTo 0
Application.DisplayAlerts = True
' Close
dwb.Close SaveChanges:=False
' Inform
If ErrNum = 0 Then
MsgBox "File saved.", vbInformation
Else
MsgBox "Could not save the file.", vbCritical
End If
End Sub

Answer 3

You may tweak your code as below...
Workbooks.Add.SaveAs Filename:=wbstring & input_file_name & ".xls", FileFormat:=56
Set wb_New = ActiveWorkbook
wb_New.Worksheets("Sheet1").Range("A1:I2000").Value = wb.Worksheets("NUMB").Range("A1:I2000").Value
'Then either use wbNew.Save or wbNew.Close True as per your need
wbNew.Save 'To save the work and leave the new workbook open
'OR
wbNew.Close True 'To save the work and close the new workbook.