Hi Team
I can quite comfortably import sheets and ranges using a variety of methods, but! this one eludes me on how to best to structure it: I have the following but it doesn't work. If someone could point me in the right direction it would be appreciated. FYI: I have all the required VB References loaded so it should be working, which means the reason it is not is due to the structuring.
TIA
Mark.
I can quite comfortably import sheets and ranges using a variety of methods, but! this one eludes me on how to best to structure it: I have the following but it doesn't work. If someone could point me in the right direction it would be appreciated. FYI: I have all the required VB References loaded so it should be working, which means the reason it is not is due to the structuring.
TIA
Mark.
VBA Code:
Sub Import()
Dim sWB As Workbook, tWB As Workbook
Dim fso, mFold, sFold, fCurr As Object
Dim cFile As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Set tWB = ThisWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
Set mFold = fso.GetFolder("T:\National\Incident Register\Current\")
'Main Folder
Set sFold = mFold.subFolders
'Sub Folders("NSW", "QLD", "SA", "VICB", "VICP")
cFile = "*.xlsb"
'there will always only ever be one file.xlsb in each sub folder above but the name will be different each month.
'When the contents of the .xlsb file has been copied, another process later will move each file to a "Historical" location, leaving the sub folder empty for a new file to be saved there.
For Each sFold In mFold
Set fCurr = sFold.Files
For Each fCurr In sFold
If fCurr.Name = cFile Then
Set sWB = Workbooks.Open(sFold.Path & "\" & cFile)
ActiveSheet.Range("A2:AC250").Copy 'There is only one sheet in each file so no need to specify a Sheet.Name
tWB.Activate
With Sheets("IncidentRegister")
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
sWB.Close SaveChanges:=False
End If
Next
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Last edited by a moderator: