VBA error when saving workbook sheet in new file location during data refresh

时间:2018-06-01 17:36:13

标签: vba excel-vba excel

I am having issues with my VBA code and am by no means an expert with VBA. This code is tied to product usage data for 30 clients. The current workbook I am using contains multiple tabs but I only want to focus on one tab, the "Template" tab, as my desired output. What I am trying to set up is a macro with an auto save of each individual clients data into its own new workbook in a specific folder location. So basically I only want one tab(ie sheet) saved out of the entire workbook for each client.

The list of clients comes from a data validation list that is tied to a table. Within the macro itself is a .RefreshAll since the data needs to be refreshed for each individual client to produce the output needed in the "Template" tab. The underlying data is tied to both Power Query and T-SQL linked to a MS SQL Server. This is what I am seeing:

When the file is saved I receive a

run time error '1004'

so the saving of the new file fails. In addition, the data refresh needs to run and finish for each individual client before moving on the the next. Which I do not believe is occurring.

Here is how I want the macro to work:

  1. Data refresh begins for first client in data validation drop down list
  2. Refresh completes
  3. "Template" sheet is copy and saved from workbook into a new workbook
  4. New workbook is placed in a new file location
  5. File name includes client name, today's date, and .xlsx extension
  6. VBA code is removed from file that was copied.
  7. Steps 1-6 repeat for the next client until it has gone through entire list of clients.

Here is the current code I am working with:

Sub ClientDataRefresh()

With ActiveWorkbook.Worksheets("Output")

Dim r As Long, i As Long

r = Range("Clients").Cells.Count

For i = 1 To r
 Range("C5") = Range("Clients").Cells(i)
 ActiveWorkbook.RefreshAll
 Worksheets("Output").Range("A1:O10").Columns.AutoFit
With ActiveWorkbook.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\Documents\Sales\"
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("Template").Select
ActiveWorkbook.Worksheets("Template").Copy
ActiveWorkbook.Worksheets("Template").SaveAs Filename:=filePath & thisName & thisDate & ".xlsx", FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True


Next i

End With

End Sub

Any feedback is most appreciative. Thank you

NEW CODE

Sub ClientDataRefresh()

With ActiveWorkbook.Worksheets("Output")

Dim r As Long, i As Long

r = Range("Clients").Cells.Count

For i = 1 To r
 Range("C5") = Range("Clients").Cells(i)
 ActiveWorkbook.RefreshAll
 DoEvents
 Worksheets("Output").Range("A1:O10").Columns.AutoFit
 thisDate = Replace(Date, "/", "-")
 thisName = Sheets("Template").Range("H7").Text
 filePath = "C:\Users\nalanis\Dropbox (Decipher Dev)\Analytics\Sales\"
 Application.DisplayAlerts = False
 ActiveWorkbook.Worksheets("Template").Select
 ActiveWorkbook.Worksheets("Template").Copy
 ActiveWorkbook.Worksheets("Template").SaveAs Filename:=filePath & thisName & " " & "Usage Report" & " " & thisDate & ".xlsx", FileFormat:=xlOpenXMLWorkbook
 Application.DisplayAlerts = True


Next i

End With

With ActiveWorkbook.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


End Sub

.PageSetup.PrintArea = "$A$1:$I$" & LR

End With

Next c

End Sub

1 个答案:

答案 0 :(得分:0)

改变这个:

<style name="MessageDialog" parent="@style/Theme.AppCompat.Light.Dialog">
    <item name="windowActionBar">false</item>
    <item name="windowNoTitle">true</item>
    <item name="android:windowNoTitle">true</item>
</style>

到此:

thisDate = Replace(Date, "\", " - ")