Excel Forum

Code: Select all

Sub EeportData()
        On Error Resume Next
        Dim sFolderPath As String
        Dim oFSO As Object
        Dim wb1 As Workbook
        Dim ws1 As Worksheet
        Dim wb2 As Workbook
        Dim Path As String
        Dim FName As String
        sFolderPath = "C:\" & Range("O2")
        'sFolderPath = "C:\PD\"
        MkDir sFolderPath
        Set wb1 = ThisWorkbook
        Set ws1 = wb1.Sheets("Exp")
        Path = sFolderPath
        'Path = "C:\PD\"
        FName = ws1.Range("M2") & ".xlsx"
        ws1.Range("A:G").Copy
        Set wb2 = Workbooks.Add
        With wb2.ActiveSheet.Range("A:G")
        .PasteSpecial (xlValues)
        .PasteSpecial (xlFormats)
        End With
        Application.DisplayAlerts = False
        wb2.SaveAs filename:=Path & FName
        Application.DisplayAlerts = True
        wb2.Close
End Sub

Code: Select all

Sub Daily_Report()
    Dim sFolderPath As String
'    Dim oFSO As Object
    Dim wb1 As Workbook
    Dim ws1 As Worksheet
    Dim wb2 As Workbook
    Dim Path As String
    Dim FName As String
    
    On Error Resume Next
    sFolderPath = "C:\" & Range("O2").Value

    'sFolderPath = "C:\PD\"
    If Dir(sFolderPath, vbDirectory) = "" Then
        MkDir sFolderPath
    End If
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Sheets("Exp")
'    Path = sFolderPath
    'Path = "C:\PD\"
    FName = ws1.Range("M2") & ".xlsx"
    ws1.Range("A:G").Copy
    Set wb2 = Workbooks.Add
    With wb2.ActiveSheet.Range("A:G")
        .PasteSpecial (xlValues)
        .PasteSpecial (xlFormats)
    End With
    Application.DisplayAlerts = False
    wb2.SaveAs Filename:=sFolderPath & "\" & FName
    Application.DisplayAlerts = True
    wb2.Close
End Sub

Code: Select all

    Set ws1 = wb1.Sheets("Exp")