Please change the old procedure DataSaveAs with this one
Please provide sheet name from which the data you want and file name should always be with extension and call procedure as belowCode:Private Sub DataSaveAs(ByVal strFilePath As String, ByVal strFileName As String, ByVal strShtName As String, ByVal strDataRange As String, ByVal SaveAs As FileType) Dim wbkSrc As Workbook Dim wksSrcSht As Worksheet Dim rngData As Range strFileName = vbNullString On Error Resume Next If Right(strFilePath, 1) <> Application.PathSeparator Then strFilePath = strFilePath & Application.PathSeparator End If strFileName = strFilePath & strFileName Set wbkSrc = Nothing Set wbkSrc = Workbooks.Open(strFileName, , True) On Error GoTo -1: Err.Clear If wbkSrc Is Nothing Then MsgBox "Please check File Name/Path is valid or not.", vbCritical, "Abort..." Exit Sub Else On Error Resume Next Set wksSrcSht = Nothing Set wksSrcSht = wbkSrc.Worksheets(strShtName) On Error GoTo 0: On Error GoTo -1: Err.Clear End If If wksSrcSht Is Nothing Then MsgBox "Provided sheet name is not exist.", vbCritical, "Abort..." Exit Sub End If If Application.DisplayAlerts Then Application.DisplayAlerts = False If Application.ScreenUpdating Then Application.ScreenUpdating = False With Workbooks.Add(1) Set rngData = wksSrcSht.Range(strDataRange) .Worksheets(1).Range("A1").Resize(rngData.Rows.Count, rngData.Columns.Count).Value = rngData.Value wbkSrc.Close 0 Call FolderExists .SaveAs Filename:=strFullPath & strFileName, FileFormat:=SaveAs, CreateBackup:=False .Close End With Set wbkSrc = Nothing Set wksSrcSht = Nothing Set rngData = Nothing If Not Application.DisplayAlerts Then Application.DisplayAlerts = True If Not Application.ScreenUpdating Then Application.ScreenUpdating = True End Sub
Code:call DataSaveAs("C:\Users\hrasheed\Desktop\Test\halau","Test.xls", "Sheet1","D4:L20",XL_CSV)![]()




Reply With Quote
Bookmarks