PDA

View Full Version : Copy updated sheet from closed workbook



pster
05-18-2007, 12:58 PM
Hi,

another big question,

I have this code:

Option Explicit
Sub ImportSalesSheet()

Dim Wkb As Workbook, BookKeep As Workbook
Dim strPath As String
Dim FileName As String
Dim strFullName As String
Dim IsOpen As Boolean
Dim i As Long

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Set sheetname to be copied
Const SheetToCopy = "Sales"
'look for the Invoice workbook in this documents path
strPath = ThisWorkbook.path
'comment line above and uncomment line below to use hard coded path for invoice.xls
'strPath = "C:\Documents\Test\"
'name of the file you wish to copy the Sales sheet from, change as needed
FileName = "Invoice.xls"


Set BookKeep = ActiveWorkbook
'Locate and delete the Sales Sheet from this workbook
On Error GoTo NotFound
i = Sheets(SheetToCopy).Index
Sheets(i).Delete
NotFound:
'Set value for i if sheet previously deleted
If i = 0 Then i = 1

strFullName = strPath & "\" & FileName
If IsWbOpen(FileName) Then
Set Wkb = Workbooks(FileName)
IsOpen = True
Else
Set Wkb = Workbooks.Open(strFullName)
IsOpen = False
End If

'Following line adds Sales sheet as the last sheet in the workbook
'Wkb.Sheets("Sales").Copy After:=BookKeep.Sheets(ThisWorkbook.Sheets.Count)
'comment line above and uncomment line below to copy sheet to same location
Wkb.Sheets(SheetToCopy).Copy Before:=BookKeep.Sheets(i)
If Not IsOpen Then Wkb.Close False

Application.ScreenUpdating = True
MsgBox "Latest version of Sales Sheet successfully copied to this workbook.", vbInformation

Application.EnableEvents = True
Application.DisplayAlerts = True
Set BookKeep = Nothing
Set Wkb = Nothing
End Sub
'Zack contributed functions to check if workbook and sheet is open and/or exists
Function IsWbOpen(wbName As String) As Boolean
On Error Resume Next
IsWbOpen = Len(Workbooks(wbName).Name)
End Function


I want to open several files and not just one and want to copy a specific worksheet to this file and not update.
Is there another code in VB that i could use?

tkx!

tkx!

mdmackillop
05-18-2007, 01:13 PM
Based on DRJ's KB item here (http://www.vbaexpress.com/kb/getarticle.php?kb_id=221)
Option Explicit

Sub CombineSheets()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "C:\AAA\" 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal) 'Change as needed
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
On Error Resume Next
Wkb.Sheets("Sheet1").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub