0

I've got multiple excel files (.xlsm), which I would like to consolidate into 1 different workbook (just specific range). The range will be always the same, which means that I need to loop through the files in specific folder / folders and copy the range and paste as values into the new workbook.

I've written a script, which I thought that could work, but it does not. It gives me an error message: enter image description here

Could you advise me what's wrong, please? It gives me the error on this line

x = Sheets("DBC PGB Review").Range("B3:E3").Copy

Or am I completely on a wrong way?

Sub LoopDBCs()

Dim myfolder As String
Dim myfile As String
Dim wb As Workbook, ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("DBCs")
Dim i As Integer

Dim x As Integer
Dim y As Integer

LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

myfolder = "F:\REQUIREMENTS\EXCEL\Retrieve DBC Data\DBCs\"
myfile = Dir(myfolder & "*.xlsm")

i = 2

Do While myfile <> ""
    Workbooks.Open Filename:=myfolder & myfile, UpdateLinks:=0
        x = Sheets("DBC PGB Review").Range("B3:E3").Copy
    ActiveWorkbook.Close savechanges:=False

    ws.Activate
    ws.Range("A:D" & LastRow + 1).PasteSpecial xlPasteValues
    
    i = i + 1

    myfile = Dir
Loop

End Sub

Many thanks!

braX
  • 11,506
  • 5
  • 20
  • 33
Srpic
  • 450
  • 5
  • 13
  • 29
  • Remove the `x=`. And read https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba Also you should probably close the file after pasting. – SJR Jul 02 '20 at 09:03
  • 1
    Try not to use things like `ActiveWorkbook` or `Select`. They can cause problems like what you are seeing (i.e. in your case when you use `ActiveWorkbook` are you trying to refer to the opened workbook or the one with the macro.. almost guessing at this point). Try and use full reference to the workbook – Zac Jul 02 '20 at 09:09

1 Answers1

0

I've avoided ActiveWorkbook or Select as @Zac and @SJR mentioned. I've specified the source and destination workbook and it works fine now. Posting the code for helping others.

Sub LoopDBCs()

Dim myfolder As String
Dim myfile As String
Dim WB As Workbook, ws As Worksheet
Dim WB2
Dim LastRow As Long

Set WB = ThisWorkbook
Set ws = WB.Sheets("DBCs")

Application.ScreenUpdating = False

'setting a path to all DBCs
myfolder = "F:\REQUIREMENTS\EXCEL\Retrieve DBC Data\DBCs\"
myfile = Dir(myfolder & "*.xlsm")

Do While myfile <> ""
    'Disabling macro alerts, external links message box
    Application.AutomationSecurity = msoAutomationSecurityForceDisable
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    
    Set WB2 = Workbooks.Open(Filename:=myfolder & myfile, ReadOnly:=True)
    
    Application.AutomationSecurity = msoAutomationSecurityByUI
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
    
    'Getting Project ID and Project Name
    WB2.Sheets("DBC PGB Review").Range("B3:E3").Copy
    
    LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    ws.Range("A" & LastRow + 1).PasteSpecial xlPasteValues
    
    WB2.Close savechanges:=False

    myfile = Dir
Loop

Application.ScreenUpdating = True

End Sub
Srpic
  • 450
  • 5
  • 13
  • 29