VBA to Insert Tab from Another Workbook

[jski21]

Good day all,

I'm using the following code to tighten up a data extract. Works ok up to the point where I'm trying to insert a tab from another workbook that is on my laptop. I--believe it or not--get a "Division by zero" error. Here's the code (trouble spot in red). This is my first attempt to pull in a tab from another file. Thanks everyone. ---jski---

Sub FormatGrantDrws()
'
' Format Downloaded Report

Dim lngLastRow As Long
Dim WB As Workbook
Dim SourceWB As Workbook
Dim WS As Worksheet
Dim ASheet As Worksheet

'Turns off screenupdating and events:
Application.ScreenUpdating = False
Application.EnableEvents = False

'Delete the first blank row and first blank column. Change font to Calibri 10.
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Cells.Select
With Selection.Font
.Name = "Calibri"
.Size = 10
End With

'Change Zoom to 90%, format numbers in Columns E thru J, and convert all data to a Table
ActiveWindow.Zoom = 90
Columns("H:H").Select
Selection.NumberFormat = "#,##0.00"
ActiveSheet.ListObjects.Add(xlSrcRange, Range([A1].End(xlDown), [A1].End(xlToRight)), , xlYes).Name = _
"Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight13"

'Autofit all the Columns
Columns("A:K").Select
Columns("A:K").EntireColumn.AutoFit
Range("A:K").Select
ActiveWindow.SmallScroll Down:=0

'Freeze pane the first row
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With

ActiveWindow.FreezePanes = True

Range("F:F").NumberFormat = "General"
Range("G1").EntireColumn.Insert
Range("G1").Select
ActiveCell.FormulaR1C1 = "Program Name"

'Combine text in Columns D and E to Produce Major Program Number

lngLastRow = Cells(Rows.Count, "F").End(xlUp).Row
Range("F2").Formula = "=D2&E2"
Range("F2").Copy Range("F3:F" & lngLastRow)

'Copy A Range of Data
Worksheets("Grant Draws").Range("F:F").Copy

'PasteSpecial Values Only
Range("F2").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Clear Clipboard (removes "marching ants" around your original data set)
Application.CutCopyMode = False

Columns("F:F").Select
Selection.NumberFormat = "###0"


Cells.Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.EntireRow.AutoFit

ActiveWorkbook.Worksheets("Grant Draws").ListObjects("Table1").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Grant Draws").ListObjects("Table1").Sort.SortFields. _
Add Key:=Range("Table1[[#All],[Jrnl Trans. Record Date]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Grant Draws").ListObjects("Table1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With



'Sets the variables:
Set WB = ActiveWorkbook
Set ASheet = ActiveSheet
THIS LINE > Set SourceWB = Workbooks.Open(C \ Users \ JKucharski \ Desktop & "\DateTable.xls")


'Copies each sheet of the SourceWB to the beginning of original WB:
For Each WS In SourceWB.Worksheets
WS.Copy before:=WB.Sheets(WB.Sheets.Count)
Next WS

SourceWB.Close savechanges:=False
Set WS = Nothing
Set SourceWB = Nothing

WB.Activate
ASheet.Select
Set ASheet = Nothing
Set WB = Nothing

Application.EnableEvents = True


'Set Precision as Dispalyed (remove (0.00) Values
ActiveWorkbook.PrecisionAsDisplayed = True
End Sub

 

[Anthony47]

Maybe it is only a typing error, but you should use
Set SourceWB = Workbooks.Open("C:\Users \JKucharski\Desktop\DateTable.xls")

Bye

 

[jski21]

Thanks for the review. This helped hone in on it. In your solution, I had to delete the space between "Users and \". Received another error. Updated the file type to ".xlsx" and it worked.

Appreciate your time Anthony47 and thanks again.

 

[Anthony47]

Thank you for your feedback