Combine 2 sets of VBA codes to open and copy

[honkin]

I have a workbook with a number of sheets and I have been slowly working towards automating opening files downloaded daily and copying the data across to the various sheets. I have 2 parts of the equation working well, but am unsure of how to combine them.

Here is what I have for opening all the files in 1 location.

Sub Open_All_Files_LTD()
Dim sFil As String
Dim sPath As String

sPath = "/Volumes/DOCUMENTS/Horse/Football Advisor/New Role/Predictology/Lay The Draw/" 'location of files
ChDir sPath
sFil = Dir("")
Do While sFil <> ""
Workbooks.Open FileName:=sPath & sFil
sFil = Dir
Loop
End Sub

This works really well to open all of the files in the specified folder one by one.

In another thread, a very kind and talented Excel guru shared some code allowing me to copy all the data in the active sheet to the desired location, including adding the source filename to column A.

Sub LAY_THE_DRAW_Weekly()
'
' Predictology
' This macro copies and pastes to the Predictology file
'
    Dim srcWB As Workbook
    Dim destSht As Worksheet, srcSht As Worksheet
    Dim destRng As Range
    Dim destLRNew As Long
        
    Set destSht = Workbooks("Predictology-Reports Football Advisor.xlsx").Sheets("Lay The Draw")

    Set srcWB = ActiveWorkbook
    Set srcSht = ActiveSheet
    With srcSht
        With .Cells(1).CurrentRegion
            .HorizontalAlignment = xlCenter
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy
        End With
    End With

    With destSht
        Set destRng = .Range("B" & Rows.Count).End(xlUp).Offset(1)
        destRng.PasteSpecial xlPasteValues
        destLRNew = .Range("B" & Rows.Count).End(xlUp).Offset(1).Row
        destRng.Resize(destLRNew - destRng.Row).Offset(0, -1).Value = Replace(srcWB.Name, ".csv", "")
    End With
    
    Application.CutCopyMode = False
End Sub

So I have both elements working well on their own. The first code opens each file one by one and the second code copies all of the data sans the header row into the correct location. How is it possible to combine the two sets of code to achieve the ultimate aim, which is to firstly open the first file in the location, copy the data, close that file and open the next and so on?

Thanks so much in advance.

 

[Michael M]

UNTESTED

Workbooks.Open FileName:=sPath & sFil
Call LAY_THE_DRAW_Weekly
sFil = Dir

 

[honkin]

UNTESTED

Workbooks.Open FileName:=sPath & sFil
Call LAY_THE_DRAW_Weekly
sFil = Dir

cheers Michael

OK, so added that line to the original and ran it, but it fell over on the very first file. I am suspecting due to the file having no data, which will be the case from time to time. It bought up this error

And the debug highlighted this line of code

destRng.Resize(destLRNew - destRng.Row).Offset(0, -1).Value = Replace(srcWB.Name, ".csv", "")

Any thoughts on a workaround to accommodate files with no data?

cheers

 

[honkin]

OK, I had a play around after some searching and have added this code to make sure it continued

End With
On Error Resume Next
    With destSht

That seemed to work through all the files in the folder, even those which were blank.

It's not vital, but would be nice if it also closed each file after the copy. I assume this line of code will achieve it

sourceWB.Close

Just wondering where in the main code to insert this.

I tried it here first

End With
        sourceWB.Close
    Application.CutCopyMode = False
End Sub

and then here

With destSht
        Set destRng = .Range("B" & Rows.Count).End(xlUp).Offset(1)
        destRng.PasteSpecial xlPasteValues
        destLRNew = .Range("B" & Rows.Count).End(xlUp).Offset(1).Row
        destRng.Resize(destLRNew - destRng.Row).Offset(0, -1).Value = Replace(srcWB.Name, ".csv", "")
        sourceWB.Close
    End With

In both locations, the files all remained open.

Any thoughts on where exactly to place that line of code?

cheers

 

[Michael M]

Put the line in red in your LAY_THE_DRAW macro

Set srcWB = ActiveWorkbook
    Set srcSht = ActiveSheet
    With srcSht
   If srcSht.UsedRange.Address = "$A$1" And srcSht.Range("A1") = "" Then exit sub
        With .Cells(1).CurrentRegion
            .HorizontalAlignment = xlCenter
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy
        End With

 

[honkin]

Thanks so much Michael, but that code has no affect on the the result. What exactly is that line doing? It still gives the same RE 1004 on the very first file....which is blank. Only when I insert the following line does it run right through all files

End With
On Error Resume Next
    With destSht

So at the moment, with that resume line, it is to the point of opening all files and copying all the required data. Just hoping to have each file closed once the copying is completed.

cheers

 

[Michael M]

shouldn't it be

srcWB.close

 

[honkin]

Put the line in red in your LAY_THE_DRAW macro

Set srcWB = ActiveWorkbook
    Set srcSht = ActiveSheet
    With srcSht
   If srcSht.UsedRange.Address = "$A$1" And srcSht.Range("A1") = "" Then exit sub
        With .Cells(1).CurrentRegion
            .HorizontalAlignment = xlCenter
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy
        End With

hi Michael

I just realised why this line you supplied did not work. When the file has no data, it still has the header row, so I changed the A references to B and it worked fine, going straight through all files, even blanks ones, so it is perfect.

 

[Michael M]

Glad you sorted itout..

 

[honkin]

shouldn't it be

srcWB.close

Hi Michael
Yes, you're right. I changed it to this instead and it attempts to close the files after each is done. The only things is each file brings up a save dialogue box. Is it possible to have the response be save when this dialogue box appears?