Import Worksheets from another workbook.. Issues

C

cratediggah

New Member
Joined
Jan 11, 2006
Messages
16
I'm having an issue where I am importing sheets from another XL file and doing a few calculations.

The issue is after I use this code, anytime I try to run another macro, the file which had sheets copied from it - RE-OPENS, as if it is still open in the background. Can anyone help troubleshoot?

Sub Import_Archive()
On Error GoTo Err_Import_Archive
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim fd As FileDialog
Dim f As String
Dim wBook As String

wBook = ThisWorkbook.Name
numSheets = ThisWorkbook.Worksheets.Count

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.Title = "Please Select Previous Forecast File"
.Filters.Clear
.Filters.Add Description:="Excel Forecast", Extensions:="*.xls", Position:=1
If .Show = True Then
f = fd.SelectedItems.Item(1)

Dim openWorkbook As String
openWorkbook = f

'Application.Visible = False
Set objBook = Workbooks.Open(f)
Set objApp = objBook.Parent

Set objSheet = objBook.Worksheets("Archive")
With objSheet
.Visible = True
.Select
.Copy After:=Workbooks(wBook).Sheets(numSheets) 'Copy after last worksheet in workbook
.Visible = False
End With

objBook.Close
objApp.Visible = True
Set objBook = Nothing
Set objApp = Nothing
Set objSheet = Nothing
Close

'Check number of families on the "Archive" sheet
Sheets("Archive").Select
Range("B1").Select
Selection.End(xlDown).Select
'Selection.End(xlDown).Select
endSubFamilyCell = ActiveCell.Address
If Len(endSubFamilyCell) = 5 Then
endSubFamilyCell = Right(endSubFamilyCell, 2)
Else
endSubFamilyCell = Right(endSubFamilyCell, 3)
End If
Range("AE1").Formula = "=COUNTA(R3C1:R" & endSubFamilyCell & "C1)"
Range("A1").Select
'Check number of families on the "Demand" sheet
Sheets("Demand").Select
Range("B1").Select
Selection.End(xlDown).Select
'Selection.End(xlDown).Select
endSubFamilyCell = ActiveCell.Address
If Len(endSubFamilyCell) = 5 Then
endSubFamilyCell = Right(endSubFamilyCell, 2)
Else
endSubFamilyCell = Right(endSubFamilyCell, 3)
End If
Range("AE1").Formula = "=COUNTA(R3C1:R" & endSubFamilyCell & "C1)"
Range("A1").Select
'Prompt User if number of families do not match!
If Sheets("Demand").Range("AE1").Value <> Sheets("Archive").Range("AE1").Value Then
'Always Import FDP Archive & Forecast, regardless of number of families, be sure to make them visible
Set objBook = Workbooks.Open(openWorkbook)
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("FDP Archive")

'Delete Current FDP Sheet
With ThisWorkbook
.Sheets("FDP Archive").Delete
End With

With objSheet
.Visible = True
.Select
.Copy After:=Workbooks(wBook).Sheets(numSheets) 'Copy after last worksheet in workbook
.Visible = False
End With

objBook.Close
objApp.Visible = True
Set objBook = Nothing
Set objApp = Nothing
Set objSheet = Nothing
Close

Set objBook = Workbooks.Open(openWorkbook)
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("Forecast")

With objSheet
.Visible = True
.Select
.Copy After:=Workbooks(wBook).Sheets(numSheets) 'Copy after last worksheet in workbook
End With

objBook.Close
objApp.Visible = True
Set objBook = Nothing
Set objApp = Nothing
Set objSheet = Nothing
Close

With ThisWorkbook
'Delete New Named Ranges that are copied in
.Names("'FDP Archive'!C_Actuals").Delete
.Names("'FDP Archive'!C_Error").Delete
.Names("'FDP Archive'!C_FDP").Delete
.Names("'FDP Archive'!C_Forecast").Delete
.Names("'FDP Archive'!C_Labels").Delete
.Names("'FDP Archive'!C_LCL").Delete
.Names("'FDP Archive'!C_UCL").Delete
.Names("'FDP Archive'!Range_Business").Delete
.Names("'FDP Archive'!Range_End_Month").Delete
.Names("'FDP Archive'!Range_Start_Month").Delete
.Names("'Archive'!C_Actuals").Delete
.Names("'Archive'!C_Error").Delete
.Names("'Archive'!C_FDP").Delete
.Names("'Archive'!C_Forecast").Delete
.Names("'Archive'!C_Labels").Delete
.Names("'Archive'!C_LCL").Delete
.Names("'Archive'!C_UCL").Delete
.Names("'Archive'!Range_Business").Delete
.Names("'Archive'!Range_End_Month").Delete
.Names("'Archive'!Range_Start_Month").Delete
.Names("'Archive'!Extract").Delete
.Names("'Forecast'!C_Actuals").Delete
.Names("'Forecast'!C_Error").Delete
.Names("'Forecast'!C_FDP").Delete
.Names("'Forecast'!C_Forecast").Delete
.Names("'Forecast'!C_Labels").Delete
.Names("'Forecast'!C_LCL").Delete
.Names("'Forecast'!C_UCL").Delete
.Names("'Forecast'!Range_Business").Delete
.Names("'Forecast'!Range_End_Month").Delete
.Names("'Forecast'!Range_Start_Month").Delete
.Sheets("FDP Archive").Visible = True
End With

Close
Sheets("FDP Archive").Tab.ColorIndex = 3
Sheets("Forecast").Select
Columns("B:B").Delete
Sheets("Forecast").Visible = True

With Sheets("Archive")
.Visible = True
.Columns("C:C").Delete
.Tab.ColorIndex = 3
End With
MsgBox "The number of Sub-Families since your last month has changed" _
& vbNewLine & "Please restore the Archive Data manually", vbCritical, "Archive Discrepancy"
Exit Sub
End If
'Loop through Archive sheet and copy data to Demand sheet
numFamilies = Sheets("Demand").Range("AE1").Value
i = 1 'Counter
s = 4 'Stat Forecast Counter
a = 5 'Adjustments Counter
f = 7 'Final Demand Plan Counter
R = 6 'Adjusted Forecast Counter
Do
Sheets("Archive").Select
'Stat Forecast
Range("D" & s & ":AL" & s & "").Select
Selection.Copy
Sheets("Demand").Select
Range("C" & s & ":AL" & s & "").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.NumberFormat = "#,##0"
.Font.Italic = True
End With
'Adjustments
Sheets("Archive").Select
Range("D" & a & ":AL" & a & "").Select
Selection.Copy
Sheets("Demand").Select
Range("C" & a & ":AL" & a & "").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.NumberFormat = "#,##0"
End With
'FDP
Sheets("Archive").Select
Range("D" & f & ":AL" & f & "").Select
Selection.Copy
Sheets("Demand").Select
Range("C" & f & ":AL" & f & "").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.NumberFormat = "#,##0"
.Font.Bold = True
End With
Range("C" & R & "").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+R[-2]C"
Range("C" & R & ":AL" & R & "").Select
With Selection
.NumberFormat = "#,##0"
.Interior.ColorIndex = 40
'.Borders(xlEdgeRight).LineStyle = xlNone
.FillRight
End With
R = R + 5
a = a + 5
s = s + 5
f = f + 5
i = i + 1
Loop Until i > (numFamilies)
Sheets("Demand").Range("A1").Select
Sheets("Archive").Visible = False

'Application.Visible = False

Set objBook = Workbooks.Open(openWorkbook)
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("FDP Archive")

'Delete Current FDP Sheet
With ThisWorkbook
.Sheets("FDP Archive").Delete
End With

With objSheet
.Visible = True
.Select
.Copy After:=Workbooks(wBook).Sheets(numSheets) 'Copy after last worksheet in workbook
.Visible = False
End With

objBook.Close
objApp.Visible = True
Set objBook = Nothing
Set objApp = Nothing
Set objSheet = Nothing

Close

Set objBook = Workbooks.Open(openWorkbook)
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("Forecast")

With objSheet
.Visible = True
.Select
.Copy After:=Workbooks(wBook).Sheets(numSheets) 'Copy after last worksheet in workbook
End With

objBook.Close
objApp.Visible = True
Set objBook = Nothing
Set objApp = Nothing
Set objSheet = Nothing

Close

With ThisWorkbook
'Delete New Named Ranges that are copied in
.Names("'FDP Archive'!C_Actuals").Delete
.Names("'FDP Archive'!C_Error").Delete
.Names("'FDP Archive'!C_FDP").Delete
.Names("'FDP Archive'!C_Forecast").Delete
.Names("'FDP Archive'!C_Labels").Delete
.Names("'FDP Archive'!C_LCL").Delete
.Names("'FDP Archive'!C_UCL").Delete
.Names("'FDP Archive'!Range_Business").Delete
.Names("'FDP Archive'!Range_End_Month").Delete
.Names("'FDP Archive'!Range_Start_Month").Delete
.Names("'Archive'!C_Actuals").Delete
.Names("'Archive'!C_Error").Delete
.Names("'Archive'!C_FDP").Delete
.Names("'Archive'!C_Forecast").Delete
.Names("'Archive'!C_Labels").Delete
.Names("'Archive'!C_LCL").Delete
.Names("'Archive'!C_UCL").Delete
.Names("'Archive'!Range_Business").Delete
.Names("'Archive'!Range_End_Month").Delete
.Names("'Archive'!Range_Start_Month").Delete
.Names("'Archive'!Extract").Delete
.Names("'Forecast'!C_Actuals").Delete
.Names("'Forecast'!C_Error").Delete
.Names("'Forecast'!C_FDP").Delete
.Names("'Forecast'!C_Forecast").Delete
.Names("'Forecast'!C_Labels").Delete
.Names("'Forecast'!C_LCL").Delete
.Names("'Forecast'!C_UCL").Delete
.Names("'Forecast'!Range_Business").Delete
.Names("'Forecast'!Range_End_Month").Delete
.Names("'Forecast'!Range_Start_Month").Delete
.Sheets("FDP Archive").Visible = False
End With

Close

Sheets("Forecast").Select
Columns("B:B").Delete
Sheets("Forecast").Visible = False

ActiveWorkbook.BreakLink Name:=openWorkbook, Type:=xlExcelLinks
Sheets("Demand").Select
Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Else
Close
End If

End With

Exit_Import_Archive:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub

Err_Import_Archive:
If Err.Number = 9 Then
MsgBox "'Archive' Worksheet Does Not Exist", vbCritical, "Selection Error"
objBook.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Else
MsgBox Err.Description
Resume Exit_Import_Archive
End If
End Sub
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
You must log in or register to reply here.

Similar threads

I
  • Question Question
Copy worksheet but the new worksheet to omit some items
2
Replies
11
Views
868
ipbr21054
I
R
  • Question Question
Copy and Paste from one workbook to another...
Replies
6
Views
401
RandyD123
R
S
  • Solved
VBA Code to select a variable folder path, find multiple .xls then copy same named worksheets into new workbook.
Replies
4
Views
783
SteveD01
S
I
  • Solved
Copy and Paste from One workbook to another
Replies
3
Views
646
ipon70
I
H
  • Question Question
Copy all tab colors from one workbook to another
Replies
3
Views
687
HyraxWithAFlamethrower
H

Forum statistics

Threads
1,222,143
Messages
6,164,171
Members
451,880
Latest member
2da

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top