• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

First VBA macro work but the second doesn't work?

navic

Active Member
I have a variable number of XLSX workbooks (product1, product2 ..... productX) from which I import data into Master.xlsm

I want to import from a closed workbook a certain range of cells 'B1: M19', which is in the same workbook in each workbook.
But I want to paste one below the other

My idea is to use a VBA macro for each workbook. So, if I have new workbooks, I add one VBA macro more.

- The first VBA macro works and copies the import range 'B1: M19' from the closed workbook to the active workbook 'Master.xlsm' in the 'Base' sheet into the cell range 'B1: M19'
- The other VBA macro doesn't work? This VBA macro should copy the range 'B2: M19' from the closed workbook to the active workbook 'Master.xlsm' in the 'Base' sheet to the cell range 'B20: M37'.

Can anyone tell why second VBA macro is not working and what lines of VBA code should be edited?

This is the VBA I use (I'm not sure how to create a VBA differently)
Code:
Option Explicit

Sub Start()
    Call product1
    Call product2
End Sub

Sub product1()
    Dim mydata As String
    Dim sPath As String
    Dim sFileName As String
    Dim sSheetName As String
    Dim sRange As String
    
    sPath = ThisWorkbook.Path & "\"
    sFileName = "product1.xlsx"
    sSheetName = "view"
    sRange = "B1:M19"
    
    mydata = "='" & sPath & "[" & sFileName & "]" & sSheetName & "'!" & sRange

    With ThisWorkbook.Worksheets("base").Range("B1:M19")
        .Formula = mydata
        .Value = .Value
    End With

End Sub

Sub product2()
    Dim mydata As String
    Dim sPath As String
    Dim sFileName As String
    Dim sSheetName As String
    Dim sRange As String
    
    sPath = ThisWorkbook.Path & "\"
    sFileName = "product2.xlsx"
    sSheetName = "view"
    sRange = "B2:M19"
    
    mydata = "='" & sPath & "[" & sFileName & "]" & sSheetName & "'!" & sRange

    With ThisWorkbook.Worksheets("base").Range("B20:M37")
        .Formula = mydata
        .Value = .Value
    End With
End Sub

'Sub product3() etc etc.....

Plesae see attached workbooks (xlsx format).
 

Attachments

  • master-chandoo.xlsx
    13.6 KB · Views: 4
  • product1.xlsx
    9.1 KB · Views: 4
  • product2.xlsx
    9.1 KB · Views: 3
In Master:
Code:
Sub Main()
  With Worksheets("Base")
    GetData .[B1:M19], ThisWorkbook.path & "\", "product1.xlsx", "view", "B1:M19"
    GetData .[B20:M37], ThisWorkbook.path & "\", "product2.xlsx", "view", "B2:M19"
  End With
End Sub

Sub GetData(toRange As Range, sPath As String, sFileName As String, sSheetName As String, _
  sRange As String)
  toRange.FormulaArray = "='" & sPath & "[" & sFileName & "]" & sSheetName & "'!" & sRange
  toRange.Value = toRange.Value
End Sub
 
To load data from all 'Product' workbooks without 'empty zero' rows, paste this demonstration to the Sheet2 (base) worksheet module :​
Code:
Sub Demo1()
  Const C = 12
    Dim D$, F$, R&, L%
        D = Dir(ThisWorkbook.Path & "\product*.xlsx"):  If D = "" Then Beep: Exit Sub
        Me.UsedRange.Clear
        Application.ScreenUpdating = False
    Do
        F = "='" & ThisWorkbook.Path & "\[" & D & "]view'!B"
        R = R + 1
        Cells(R, 2).Resize(4 - (R = 1), C).Formula = F & 2 + (R = 1)
        R = R + 4 - (R = 1)
    For L = 7 To 15 Step 4
        Cells(R, 2).Resize(3, C).Formula = F & L
        R = R + 3
    Next
        Cells(R, 2).Resize(1, C).Formula = F & "19"
        D = Dir
    Loop Until D = ""
    With [B1].CurrentRegion
        .Formula = .Value2
        .Cells(1).Clear
    End With
        Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 
As sometimes playing with formulas to load data from a closed workbook can be a mess​
for an unique cell I prefer to use the ExecuteExcel4Macro VBA method but for an entire worksheet like your 'view' attachment​
the way to use is the ADODB connection in particular for several source workbooks (paste to the Sheet2 (base) worksheet module) :​
Code:
Sub Demo2()
    Dim D$, oCn As Object, S$
        D = Dir(ThisWorkbook.Path & "\product*.xlsx"):  If D = "" Then Beep: Exit Sub
        Set oCn = CreateObject("ADODB.Connection")
        S = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\#;Extended Properties=""Excel 12.0"
        Me.UsedRange.Clear
        Application.ScreenUpdating = False
        oCn.Open Replace(S & ";HDR=No""", "#", D)
        [B1].CopyFromRecordset oCn.Execute("[view$1:1]")
        oCn.Close
        S = S & """"
    Do
        oCn.Open Replace(S, "#", D)
        Cells(Me.UsedRange.Rows.Count + 1, 2).CopyFromRecordset oCn.Execute("[view$]")
        oCn.Close
        D = Dir
    Loop Until D = ""
        [C2].Resize(Me.UsedRange.Rows.Count - 1, Me.UsedRange.Columns.Count - 1).NumberFormat = "#,##0.00"
        Application.ScreenUpdating = True
        Set oCn = Nothing
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 
To load 'view' data without any blank row the second Execute SQL string (the one within the Do Loop block)
must be amended like this : oCn.Execute("[view$] ]WHERE F1>''") …​
Another SQL syntax : WHERE F1 IS NOT NULL …​
You may Like this !​
 
Back
Top