CODEWITHSUNDEEP
vbaexcel
naa34
naa34

Reputation: 5

Need assistance updating macro to copy and save worksheet instead of entire workbook

I have the following macro that loops through a list of clients and saves individual workbooks for each client in a specific file location. The issue that is going over my head is I want to only save one particular worksheet in the workbook per client and not all of the tabs from the workbook.

Here is the entire macro:

Sub ClientDataRefresh()

    With ThisWorkbook.Worksheets("Output")

    Dim dvCell As Range
    Dim inputRange As Range
    Dim c As Range
    Dim i As Long

     'Cell that has data validation
    Set dvCell = ThisWorkbook.Worksheets("Output").Range("C5")
     'Determine where validation comes from
    Set inputRange = Evaluate(dvCell.Validation.Formula1)

    i = 1
     'Begin loop
     Application.ScreenUpdating = False
     For Each c In inputRange
     dvCell = c.Value
     ThisWorkbook.RefreshAll
     ThisWorkbook.Worksheets("Output").Range("A1:O10").Columns.AutoFit

    With ThisWorkbook.Worksheets("Template")
    LR = .Cells(Rows.Count, 7).End(xlUp).Row
    10: If .Cells(LR, 7) = "" Then LR = LR - 1: GoTo 10
    .PageSetup.PrintArea = "$A$1:$I$" & LR
    End With

     thisDate = Replace(Date, "/", "-")
     thisName = Sheets("Template").Range("H7").Text
     filePath = "C:\Users\nalanis\Dropbox (Decipher Dev)\Analytics\Sales\"
     Application.DisplayAlerts = False
     ThisWorkbook.Worksheets("Template").Select
     ThisWorkbook.Worksheets("Template").Copy
     ThisWorkbook.Worksheets("Template").SaveAs Filename:=filePath & thisName & " " & "Usage Report" & " "  & thisDate & ".xlsx", FileFormat:=xlOpenXMLWorkbook
     Application.DisplayAlerts = True
     ActiveWorkbook.Close
    Next c

    End With


End Sub

I have tried looking and applying different potential solutions but no such luck.

Upvotes: 0

Views: 81

Answers (1)

TBoulz
TBoulz

Reputation: 351

This is the code i've used to save only 1 worksheet as a .csv file. Basically it removes every sheet other than the sheet I want ("Pending") and saves it as .csv, but then closes the original workbook without saving, as to not save with all the deletions I did.

Dim excelObject As Object
Dim objExcel As Object
Dim sheet As Object
Dim csvFile As String
xlFile = "C:\Users\PathName.xlsx"
csvFile = Left(xlFile, InStrRev(xlFile, ".")) & "csv"

'open excel file
Set objExcel = CreateObject("Excel.Application")
Set excelObject = objExcel.Workbooks.Open("C:\Users\PathName.xlsx")
'Recognize the sheet we are looking to import
Set sheet = excelObject.Worksheets("Pending")
'suppresses dialog boxes when deleting worksheets
excelObject.Application.DisplayAlerts = False
Dim wsName As String

'Delete all sheets except the one sheet we want
wsName = "Pending"

For Each Sh In excelObject.Worksheets
    If Sh.Name <> wsName Then
        Sh.Delete
    End If
Next Sh

'Save the file as a CSV but do not save the original workbook we edited
objExcel.ActiveWorkbook.SaveAs csvFile, FileFormat:=6, CreateBackup:=False
excelObject.Close

'Closes out of excel and removes it from the computer memory
objExcel.Quit
Set objExcel = Nothing

Upvotes: 1

Related Questions