Code not copying and transposing data from all other files in Directory

[Ochimus]

User has a MASTER and two UPLOAD files in same Folder.

Code should open each workbook in turn and, if is not the MASTER workbook, copy the data from Sheet 1 of the UPLOAD file, transpose and paste it to next free row on sheet 1 of MASTER, close the UPLOAD workbook, and move on to next one:

Option Explicit
Dim f As Long
Dim Filename As String
Dim wbDst As Workbook, wbSrc As Workbook
Dim wsDst As Worksheet, wsSrc As Worksheet

Sub MergeFilesInFolder()

'Find next free row in Master sheet

    With ActiveSheet
    f = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    If f < 2 Then f = 2
    
    Set wbDst = ThisWorkbook
    Set wsDst = ActiveSheet
    
                
'Loop through all files in folder

    Filename = Dir(CurDir() & "\*.xlsx")
    
'Ignore the Master workbook
 
'**Throwing Runtime Error 438 here   
    Do While Filename <> "" And Filename <> wbDst
        Set wbSrc = Workbooks.Open(Filename)

'Copy all date from Source sheet
            With wbSrc
            Set wsSrc = .Sheet1
            wsSrc.Range("A1").UsedRange.Copy
                    
'Transpose and paste to last row on this worksheet

            With wsDst
            .Range("A" & f).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
            End With
            
'Close other file without saving changes
            wbSrc.Close savechanges:=False
            
            End With
            
'Move to next workbook

            Filename = Dir
    
    Loop
    
    End With
    
End Sub

Any solutions, suggestions or alternatives welcome as ever.

Ochimus

[Marc L]

Delete first Module1 then paste this VBA demonstration to the Sheet1 (COMBINED STOCK) worksheet module :

Sub Demo1()
    Dim P$, F$, R&
        P = ThisWorkbook.Path & "\"
        F = Dir$(P & "*.xlsx"):  If F = "" Then Beep: Exit Sub
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    Do
               R = UsedRange.Rows.Count - (UsedRange.Rows.Count > 1)
        With Workbooks.Open(P & F, 0).Sheets(1).UsedRange.Columns
            .Item(2 + (R = 1)).Resize(, .Count + (R > 1)).Copy
             Cells(R, 1).PasteSpecial , , , True
            .Parent.Parent.Close False
        End With
               F = Dir$
    Loop Until F = ""
        .DisplayAlerts = True
        .Goto [A1], True
        .ScreenUpdating = True
    End With
End Sub 

► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

[Ochimus]

Marc,

Appreciate the prompt response and suggestion.

Unfortunately the line
'F = Dir$(P & "*.xlsx"): If F = "" Then Beep: Exit Sub'
throws a Run-Time error 52 ("Bad File Name or Number"), though can't see why as the MASTER and both UPLOADS on my machine are in the same Folder?

And nor clear where the Code transposes the Cols and Rows?

Ochimus

[Marc L]

No such issue on my side with your attachment, well works as expected so the bad is on your side …

And PasteSpecial statement transposes the data.

[Sintek]

Sub J3v16()
Dim Ws As Worksheet, File As Object
Set Ws = ThisWorkbook.Sheets("Combined Stock")
For Each File In CreateObject("Scripting.filesystemobject").getfolder(ThisWorkbook.Path).Files
    If Not File Like "*MASTER*" Then
        With Workbooks.Open(File)
            .ActiveSheet.UsedRange.Copy
            Ws.Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues, Transpose:=True
            Application.CutCopyMode = False
            .Close False
        End With
    End If
Next File
End Sub

[Ochimus]

sintek,

Appreciate your response and proposal, but sadly this also throws an error.

I even replicated the Folder and Contents on the Hard Drive, in case the errors were, for whatever reason, because the files were in the Cloud.

Attached screenshot demonstrates the Master and Upload files are all in the same Folder, and the two Code screenshots confirm the lines that generate the Error Messages which are also presented.

Have no idea what "bad" Marc can suggest is causing the issue on the machine, so open to all suggestions?

Ochimus

[bakerman2]

Just tested both codes and they work as expected.

For Marc's code to work you need to put it in the Worksheet module of Combined stock. To do so right-click Combined Stock tab and select View Code.

Paste his code in the right pane and run it from there.

Sintek's code can be placed in a standard code module.

[Marc L]

Ochimus,

try to create a new folder on the local drive like C:\Tests\ then copy the 3 workbooks in this new folder
then just follow the easy direction within my post or the previous post, it should work thus meaning it's a grant access issue …

[Ochimus]

Well, definitely interesting.

Took Marc's suggestion, created Tests as a folder in the root drive.
Marc's program, run from the worksheet, did the job but started on row 13 then when run again with a blank sheet, started from row 33, and so on. Then ran Sintek's Code from the Module, which ran perfectly.
BUT when I created a "Tests" folder in the Cloud as a SUB Directory, both approaches fell over again!

Never come across this issue before this, and no idea why it happens on this structure only?

Ochimus

[Sintek]

Hard code your path...So change Thisworkbook.Path to your hard coded path...and test

I assume your cloud path is something like..."https://"