I have a list of *.xlsm file names on a sheet named "DB" in range E961 to E1010 (50 rows) and I'm trying to create a macro that runs through this list and open the corresponding files in the set directory, runs some code and close the file, moving on to the next file on the list - repeating this operation every 5 minutes.
The directory contains 400+ xlsm files, and the list in E961 will typically be less than 50 files - so I'm not trying to open all the files in the directory. That already happens once a day at a set time.
But I am trying to open these "shortlisted" files and update them every 5 minutes for example. I tried different combinations of code but can't seem to get it working.
The main file containing this code is also in the same directory to allow relative linking to the other 400+ files, hence the ThisWorkbook.Path code.
Edited code below:
Sub UPDATE()
Application.ScreenUpdating = True
With ThisWorkbook.Worksheets("DB")
Dim inputRange As Range
Set inputRange = .Range("E961", .Cells(.Rows.Count, 5).End(xlUp))
End With
Dim directory As String: directory = ThisWorkbook.Path & "\"
Dim fileName As String
Dim r As Range
Dim xlwb As Workbook
For Each r In inputRange
If r <> vbNullString Then
fileName = Dir(directory & r & ".xl??*")
Set xlwb = Workbooks.Open(directory & fileName)
Application.DisplayAlerts = False
ActiveWorkbook.RefreshAll
If Range("A4") > Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Offset(0) Then
Worksheets("DB").Range("A4:L4").Select
Worksheets("DB").Range("A4").Activate
Selection.Copy
Sheets("DB").Select
Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Offset(1). _
PasteSpecial Paste:=xlPasteValues, _
SkipBlanks:=True, Transpose:=False
Application.CutCopyMode = False
Else
End If
If Range("A4") = Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Offset(0) Then
Worksheets("DB").Range("A4:L4").Select
Worksheets("DB").Range("A4").Activate
Selection.Copy
Sheets("DB").Select
Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Offset(0). _
PasteSpecial Paste:=xlPasteValues, _
SkipBlanks:=True, Transpose:=False
Application.CutCopyMode = False
End If
xlwb.Close True
End If
Next r
Application.ScreenUpdating = True
End Sub
The error comes from "Set xlwb = (sht.Cells(Row, 1).Value)" because it is trying to open a sheet as a workbook, but I have no idea how to fix it... or everything is wrong ...
Thanks for the help!
Try this piece it should work thought it will only open and close workbooks until you give it some code to work them:
Option Explicit
Sub UPDATE()
Application.ScreenUpdating = False
'if you are only using here your wb and sht variables, use a With, there is no need to use variables
With ThisWorkbook.Worksheets("DB")
Dim inputRange As Range
'It is preferable to do xlUp because you could find some empty cells in between.
Set inputRange = .Range("E961", .Cells(.Rows.Count, 5).End(xlUp))
End With
Dim directory As String: directory = ThisWorkbook.Path & "\"
Dim fileName As String
Dim r As Range
Dim xlwb As Workbook
For Each r In inputRange
If r <> vbNullString Then
fileName = Dir(directory & r & ".xl??*") 'don't know if your cell has the extension
Set xlwb = Workbooks.Open(directory & fileName)
'some code
xlwb.Close False 'False won't save the workbook, use True if you want it to be saved.
End If
Next r
Application.ScreenUpdating = True
End Sub
Related
I have a macro in workbook A that calls a macro in workbook B. I want the macro in workbook B to run and then I want to close workbook B. I keep getting an error saying the macro cannot be found that I want to run from workbook B. I am pretty much a novice at this, but I have done a pretty thorough search and haven't been able to come up with anything on my own. Here is my code in it's entirety.
Public Sub InputDept()
Dim Cap As Workbook
Dim Cap2 As String
On Error Resume Next
Set Cap = Workbooks("NGD Source File for Net Budget Reporting.xlsx")
Cap2 = Cap.Name
On Error GoTo 0
Dim wb As Workbook
Dim Cap1 As Variant
Application.ScreenUpdating = False
If Cap Is Nothing Then
Cap1 = Application.GetOpenFilename("Excel Files(*.xl*)," & "*.xl*", 1)
If Cap1 = False Then
Exit Sub
End If
Set wb = Workbooks.Open(Cap1)
Cap2 = ActiveWorkbook.Name
Else
Workbooks(Cap2).Activate
End If
Sheets("Dept Summary").Activate
Cells.Find(What:="Direct", after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Dim cRng As Range
Dim dRng As Range
Set dRng = Selection
For Each cRng In dRng
If cRng.Interior.ThemeColor = xlThemeColorAccent3 Then
Dim mCalc As String
Dim mSum As Workbook
On Error Resume Next
Set mSum = Workbooks("Master Calc with Macro.xlsm")
mCalc = mSum.Name
On Error GoTo 0
Application.ScreenUpdating = False
If mSum Is Nothing Then
mSum1 = Application.GetOpenFilename("Excel Files.xl*),"& "*.xl*", 1)
If mSum1 = False Then
Exit Sub
End If
Set wb1 = Workbooks.Open(mSum1)
mCalc = ActiveWorkbook.Name
Else
Workbooks(mCalc).Activate
End If
cRng.Copy
Workbooks(mCalc).Activate
Sheets("Data").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Report").Activate
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
Sheets("Report").Select
ActiveSheet.Copy
Cells.Select
Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.SaveAs _
Filename:=Application.ThisWorkbook.Path & "\" & Format(Date - 28, "MMM") & " Files\" & Left(cRng, 7) & ".xlsx"
ActiveWorkbook.Close
Workbooks(mCalc).Close savechanges:=False
End If
Next cRng
End Sub
This line:
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
needs to be changed a little. You need to include the name of the workbook inside a single quotes, even if it looks like you are specifying the proper workbook with Workbooks(mCalc):
Workbooks(mCalc).Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
You can actually just shorten it to:
Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
If the macro you need to find relative macro path by using workbook path from which you run macro and you need to run several macros from the array list, the code below will help:
Dim relativePath As String, programFileName As String
Dim selectedProgramsFiles() As String, programsArrayLastIndex As Byte, I As Byte
For I = 0 To programsArrayLastIndex 'Loop through all selected programs
programFileName = selectedProgramsFiles(I)
relativePath = ThisWorkbook.Path & "\" & programFileName
Workbooks.Open Filename:=relativePath
Application.Run ("'" & relativePath & "'!ModuleName.Main")
Workbooks(programFileName).Activate
ActiveWorkbook.Close SaveChanges:=False
Next I 'For I = 0 To programsArrayLastIndex 'Loop through all selected program
Application.Run "PERSONAL.xlsb!ClearYellow", 0
ClearYellow is the name of the sub in Personal.xlsb that is being run.
The "0" is the first argument of this sub (would omit if no arguments, could add more arguments separated by commas)
Application does not seem to be needed
This could be used to run from some other workbook also; the workbook would have to be open; if the name of that workbook had a space in it, the name would have to be surrounded by ''
Call does not work cross workbooks; haven’t tested within same workbook or within same module
I have a macro in workbook A that calls a macro in workbook B. I want the macro in workbook B to run and then I want to close workbook B. I keep getting an error saying the macro cannot be found that I want to run from workbook B. I am pretty much a novice at this, but I have done a pretty thorough search and haven't been able to come up with anything on my own. Here is my code in it's entirety.
Public Sub InputDept()
Dim Cap As Workbook
Dim Cap2 As String
On Error Resume Next
Set Cap = Workbooks("NGD Source File for Net Budget Reporting.xlsx")
Cap2 = Cap.Name
On Error GoTo 0
Dim wb As Workbook
Dim Cap1 As Variant
Application.ScreenUpdating = False
If Cap Is Nothing Then
Cap1 = Application.GetOpenFilename("Excel Files(*.xl*)," & "*.xl*", 1)
If Cap1 = False Then
Exit Sub
End If
Set wb = Workbooks.Open(Cap1)
Cap2 = ActiveWorkbook.Name
Else
Workbooks(Cap2).Activate
End If
Sheets("Dept Summary").Activate
Cells.Find(What:="Direct", after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Dim cRng As Range
Dim dRng As Range
Set dRng = Selection
For Each cRng In dRng
If cRng.Interior.ThemeColor = xlThemeColorAccent3 Then
Dim mCalc As String
Dim mSum As Workbook
On Error Resume Next
Set mSum = Workbooks("Master Calc with Macro.xlsm")
mCalc = mSum.Name
On Error GoTo 0
Application.ScreenUpdating = False
If mSum Is Nothing Then
mSum1 = Application.GetOpenFilename("Excel Files.xl*),"& "*.xl*", 1)
If mSum1 = False Then
Exit Sub
End If
Set wb1 = Workbooks.Open(mSum1)
mCalc = ActiveWorkbook.Name
Else
Workbooks(mCalc).Activate
End If
cRng.Copy
Workbooks(mCalc).Activate
Sheets("Data").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Report").Activate
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
Sheets("Report").Select
ActiveSheet.Copy
Cells.Select
Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.SaveAs _
Filename:=Application.ThisWorkbook.Path & "\" & Format(Date - 28, "MMM") & " Files\" & Left(cRng, 7) & ".xlsx"
ActiveWorkbook.Close
Workbooks(mCalc).Close savechanges:=False
End If
Next cRng
End Sub
This line:
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
needs to be changed a little. You need to include the name of the workbook inside a single quotes, even if it looks like you are specifying the proper workbook with Workbooks(mCalc):
Workbooks(mCalc).Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
You can actually just shorten it to:
Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
If the macro you need to find relative macro path by using workbook path from which you run macro and you need to run several macros from the array list, the code below will help:
Dim relativePath As String, programFileName As String
Dim selectedProgramsFiles() As String, programsArrayLastIndex As Byte, I As Byte
For I = 0 To programsArrayLastIndex 'Loop through all selected programs
programFileName = selectedProgramsFiles(I)
relativePath = ThisWorkbook.Path & "\" & programFileName
Workbooks.Open Filename:=relativePath
Application.Run ("'" & relativePath & "'!ModuleName.Main")
Workbooks(programFileName).Activate
ActiveWorkbook.Close SaveChanges:=False
Next I 'For I = 0 To programsArrayLastIndex 'Loop through all selected program
Application.Run "PERSONAL.xlsb!ClearYellow", 0
ClearYellow is the name of the sub in Personal.xlsb that is being run.
The "0" is the first argument of this sub (would omit if no arguments, could add more arguments separated by commas)
Application does not seem to be needed
This could be used to run from some other workbook also; the workbook would have to be open; if the name of that workbook had a space in it, the name would have to be surrounded by ''
Call does not work cross workbooks; haven’t tested within same workbook or within same module
I am working on automating an excel model by copying data from other sheets into a masterfile. I have a bit of an issue that after adding the code the file went from 25mb to 60mb, without changing the content, only adding the code. Below you can find a snippet of how I automated the imports
Sub copytest() 'Procedure for retrieving data from the sourcefiles
Dim wbTarget, wbSource As Workbook
Dim target As Object
Dim pathSource, fileName As String
Dim xlApp As Application
Dim lastRow As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
'path where the data source folders are located (please keep all of them in the same directory)
pathSource = "C:\Users\vferraz\Desktop\crm stock\RAPOARTE IMPORTANTE\18.02\Rapoarte pentru Handsets\"
Set wbTarget = ThisWorkbook
Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
Application.CutCopyMode = False
'Stock 0001
Set wbSource = xlApp.Workbooks.Open(pathSource & "Stoc 0001.xls")
wbSource.Sheets(1).UsedRange.Copy
wbSource.Close
Set target = wbTarget.Sheets("Stock 0001")
target.UsedRange.Clear
Range("A1").Select
target.Paste
xlApp.Quit
Set wbSource = Nothing
Set xlApp = Nothing
ThisWorkbook.Sheets("Mastersheet").Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
In the snippet above I only added the parsing of one file (Stock 0001), but the same method is done for other 10-15 files.
Does anyone have any ideas to improve the efficiency/size of this file based on this procedure?
P.S. Im aware that the "Paste" method might be adding formats rather than values only, then I tried adding .PasteSpecial xlPasteValues instead of paste but it eventually throw errors that I couldn't identify
Update:
Based on this solution, this is the new version I tried:
Stock 0001
Set wbSource = xlApp.Workbooks.Open(pathSource & "Stoc 0001.xls")
lastRow = wbSource.Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
wbTarget.Sheets("Stock 0001").Cells.Clear
wbSource.Sheets(1).Range("A1:C" & lastRow).Copy Destination:=wbTarget.Sheets("Stock 0001").Range("A1")
wbSource.Clo
The line wbSource.Sheets(1).Range("A1:C" & lastRow).Copy Destination:=wbTarget.Sheets("Stock 0001").Range("A1" Throws the "copy method of range class failed error.
Instead of this
'Stock 0001
Set wbSource = xlApp.Workbooks.Open(pathSource & "Stoc 0001.xls")
wbSource.Sheets(1).UsedRange.Copy
wbSource.Close
Set target = wbTarget.Sheets("Stock 0001")
target.UsedRange.Clear
Range("A1").Select
target.Paste
Try this
wbSource.Sheets(1).Columns("").Copy Destination:=wbTarget.Sheets("Stock 0001").Range("A1")
Where I've put Columns just replace this with whatever range you are using via Range() or Cells etc
Copy and Paste takes a while, and has issues if you are already copying something in another location. This just takes the data for you
Also, this piece of code will be your friend forever
With Sheets("Sheet1")
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
This finds the bottom row of Column A (or whatever your "always populated" column will be
Sub LastRow()
Dim wb As Workbook, ws As Worksheet, LastRow As Long
Set wb = ThisWorkbook
Set ws = Worksheets("Data")
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
With ws.Range(ws.Cells(2, 13), ws.Cells(LastRow, 13))
'This is Range M2:M(bottom)
.
.
'etc
.
End With
End Sub
Edit....3:
Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
Application.CutCopyMode = False
'Stock 0001
Set wbSource = xlApp.Workbooks.Open(pathSource & "Stock 0001.xls")
Instead of all this, please use
Set wbSource = Workbooks.Open(pathSource & "Stock 0001.xls")
You also need error handling in your code. When it breaks (file doesn't exist, path is invalid, sheet doesn't exist) between
Application.EnableEvents = False
Application.ScreenUpdating = False
and
Application.EnableEvents = True
Application.ScreenUpdating = True
you're going to end up with Excel in a bad state where screen updating is off and events will no longer fire. What you should have is something long the lines of
On Error GoTo ExitErr
Application.EnableEvents = False
Application.ScreenUpdating = False
Then after your code, you should have
ExitErr:
Application.EnableEvents = True
Application.ScreenUpdating = True
I found a way to reduce the file size back to how it used to be by adding the following line to the imports after the paste command
target.Cells.ClearFormats
In this case the formats taken from the data were cleared.
I have a macro in workbook A that calls a macro in workbook B. I want the macro in workbook B to run and then I want to close workbook B. I keep getting an error saying the macro cannot be found that I want to run from workbook B. I am pretty much a novice at this, but I have done a pretty thorough search and haven't been able to come up with anything on my own. Here is my code in it's entirety.
Public Sub InputDept()
Dim Cap As Workbook
Dim Cap2 As String
On Error Resume Next
Set Cap = Workbooks("NGD Source File for Net Budget Reporting.xlsx")
Cap2 = Cap.Name
On Error GoTo 0
Dim wb As Workbook
Dim Cap1 As Variant
Application.ScreenUpdating = False
If Cap Is Nothing Then
Cap1 = Application.GetOpenFilename("Excel Files(*.xl*)," & "*.xl*", 1)
If Cap1 = False Then
Exit Sub
End If
Set wb = Workbooks.Open(Cap1)
Cap2 = ActiveWorkbook.Name
Else
Workbooks(Cap2).Activate
End If
Sheets("Dept Summary").Activate
Cells.Find(What:="Direct", after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Dim cRng As Range
Dim dRng As Range
Set dRng = Selection
For Each cRng In dRng
If cRng.Interior.ThemeColor = xlThemeColorAccent3 Then
Dim mCalc As String
Dim mSum As Workbook
On Error Resume Next
Set mSum = Workbooks("Master Calc with Macro.xlsm")
mCalc = mSum.Name
On Error GoTo 0
Application.ScreenUpdating = False
If mSum Is Nothing Then
mSum1 = Application.GetOpenFilename("Excel Files.xl*),"& "*.xl*", 1)
If mSum1 = False Then
Exit Sub
End If
Set wb1 = Workbooks.Open(mSum1)
mCalc = ActiveWorkbook.Name
Else
Workbooks(mCalc).Activate
End If
cRng.Copy
Workbooks(mCalc).Activate
Sheets("Data").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Report").Activate
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
Sheets("Report").Select
ActiveSheet.Copy
Cells.Select
Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.SaveAs _
Filename:=Application.ThisWorkbook.Path & "\" & Format(Date - 28, "MMM") & " Files\" & Left(cRng, 7) & ".xlsx"
ActiveWorkbook.Close
Workbooks(mCalc).Close savechanges:=False
End If
Next cRng
End Sub
This line:
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
needs to be changed a little. You need to include the name of the workbook inside a single quotes, even if it looks like you are specifying the proper workbook with Workbooks(mCalc):
Workbooks(mCalc).Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
You can actually just shorten it to:
Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
If the macro you need to find relative macro path by using workbook path from which you run macro and you need to run several macros from the array list, the code below will help:
Dim relativePath As String, programFileName As String
Dim selectedProgramsFiles() As String, programsArrayLastIndex As Byte, I As Byte
For I = 0 To programsArrayLastIndex 'Loop through all selected programs
programFileName = selectedProgramsFiles(I)
relativePath = ThisWorkbook.Path & "\" & programFileName
Workbooks.Open Filename:=relativePath
Application.Run ("'" & relativePath & "'!ModuleName.Main")
Workbooks(programFileName).Activate
ActiveWorkbook.Close SaveChanges:=False
Next I 'For I = 0 To programsArrayLastIndex 'Loop through all selected program
Application.Run "PERSONAL.xlsb!ClearYellow", 0
ClearYellow is the name of the sub in Personal.xlsb that is being run.
The "0" is the first argument of this sub (would omit if no arguments, could add more arguments separated by commas)
Application does not seem to be needed
This could be used to run from some other workbook also; the workbook would have to be open; if the name of that workbook had a space in it, the name would have to be surrounded by ''
Call does not work cross workbooks; haven’t tested within same workbook or within same module
While writing a piece of code I encountered the "Subscript out of range" message.
The structure of the folder is the following:
D:\Documents main directory
Inside it there are:
the xls workbook with the code
a file 1.csv to which I need to copy data
a folder WiP which contains csv files with the data
The code currently looks like this
Sub MergeData()
'
' Ìàêðîñ1 Ìàêðîñ
' Provide path to workbooks,
' there is a folder with about 100 csv books from which I should collect data into one
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = ActiveWorkbook.Path & "\WiP\"
Filename = Dir(Pathname & "*.csv")
' Open a workbook in which the data should be pasted
Workbooks.Open ("D:\Documents\1.csv")
ActiveSheet.Cells(1, 1).Value = "date"
ActiveSheet.Cells(1, 2).Value = "hour"
ActiveSheet.Cells(1, 3).Value = "num"
ActiveSheet.Cells(1, 4).Value = "p"
' Call the code
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
IntegrateDays wb
wb.Close savechanges:=False
Filename = Dir()
Loop
' Close the workbook with data
Workbooks("D:\Documents\1.csv").Close savechanges:=True
End Sub
Sub IntegrateDays(wb As Workbook)
Dim ws As Worksheet
With wb
' Open workbooks, copy a range
Sheets(1).Activate
Dim rng As Range
Set rng = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
rng.Copy
' Paste the range into 1.csv
Workbooks("D:\Documents\1.csv").Worksheets(1).Range("B" & Worksheets(1).UsedRange.Rows.Count + 1).Activate
rng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Set NextRow = Nothing
End With
End Sub
The code runs until it has to paste the copied range rng into 1.csv and stops with an error.
The first guess is that this may be an error related to range.activate. I attempted to test it by doing the operation without loop and only selecting one cell and further by just opening 1.csv prior to even selecting any ranges. The error remains.
The second suspicion is that there is an issue opening 1.csv. By looking though searches such as "subscript out of range opening csv" I didn't find any heavily discussed issues which would help with this question.
Could you please kindly advise me what caused the error and how to rewrite the code?
Thank you very much in advance.
Evgeniya.
You shouldn't be using rng.PasteSpecial. The parent of the Range.PasteSpecial method should be the destination; not the source.
Since you are interested in getting the values over, abandon the PasteSpecial in favor of direct value transfer.
Dim rng As Range
with Sheets(1)
Set rng = .Range(Cells(1, 1), Cells(1, 1).End(xlDown))
end with
with Workbooks("D:\Documents\1.csv").Worksheets(1)
.cells(rows.count, "B").end(xlup).offset(1,0).resize(rng.rows.count, rng.columns.count) = rng.Value
end with
Are you trying to copy from a workbook into others?
Try adjust this
Application.ScreenUpdating = False
Columns("A:C").Sort Key1:=Range("C2"), _
Order1:=xlDescending, Header:=xlYes
Application.ScreenUpdating = True
Dim WBookCopy As Workbook
Dim WBookPst As Workbook
Dim Filepath As String
Dim SheetName As String
Dim sheetCopy As Worksheet
Set WBookPst = Application.ActiveWorkbook
Call DeleteCache
'B2 is the location directory of latest Excel file
Filepath = Range("B2").Value
Set WBookCopy = Workbooks.Open(Filepath)
Set sheetPst = WBookPst.Worksheets(2)
Set sheetCopy = WBookCopy.Worksheets(1)
sheetCopy.UsedRange.Copy sheetPst.Range("A:AG")
sheetCopy.UsedRange.Value = sheetCopy.UsedRange.Value
WBookCopy.Close (False)