需要帮助更新宏以复制和保存工作表而不是整个工作簿

时间:2018-06-05 15:12:56

标签: excel vba excel-vba

我有以下宏来遍历客户端列表,并为特定文件位置中的每个客户端保存单个工作簿。我想要的问题是,我只想在每个客户端的工作簿中保存一个特定的工作表,而不是工作簿中的所有选项卡。

以下是整个宏:

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

我试过寻找并应用不同的潜在解决方案,但没有这样的运气。

1 个答案:

答案 0 :(得分:1)

这是我用来仅将1个工作表保存为.csv文件的代码。基本上它删除了我想要的所有工作表以外的所有工作表("待定")并将其保存为.csv,但随后关闭原始工作簿而不保存,以便不保存所有删除操作。

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