Looking for some help, it's been a while....

[cweggleto81]

Hi Guys,Gals..

 

[cweggleto81]

Sorry, for some reason I posted the start of a message and didn't continue it...

So I am looking for a little help... this is what I need to do.

I have a Master workbook and a folder full of workbooks that contain charges for different customers.

I have named 3 cells in each of the charges workbooks ACCNTNAME, ACCNTNUM, AND TOTALCOST.

What I need to do from the master sheet is to loop through all the charges files in the directory and copy ONLY these specific named cells into the master sheet, starting at a certain cell down downwards so it would look like;

ACCNTNAME ACCNTNUM TOTALCOST
ACCNTNAME ACCNTNUM TOTALCOST

And repeat going down until it has completed the loop. I haven't touched vba in a while and am having a real issue lol.

Any advice would be appreciated.

Regards

 

[Trebor76]

Hi cweggleto81,

Welcome to MrExcel!!

See how this goes:

Option Explicit
Sub Macro1()
    
    Dim objFSO As Object, objFolder As Object, objFile As Object
    Dim strFolderName As String
    Dim wb As Workbook
    Dim lngMyRow As Long
    
    Application.ScreenUpdating = False
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    strFolderName = "C:\" '<-Foler containing Excel files. Remember trailing "\". Change to suit.
   
    Set objFolder = objFSO.GetFolder(strFolderName)
   
    For Each objFile In objFolder.Files
        If InStr(objFSO.GetExtensionName(objFile.Name), "xls") > 0 Then 'Only interested in Excel files
            Set wb = Workbooks.Open(objFolder & objFile.Name)
            'Puts the data from the named ranges into the next available row in columns A, B abd C in 'Sheet1'. Change to suit if necessary.
            On Error Resume Next 'In case there's no data in 'Sheet1' manually set the variable
                lngMyRow = ThisWorkbook.Sheets("Sheet1").Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                If lngMyRow = 0 Then
                    lngMyRow = 2 'Default initial output row number. Change to suit if necessary
                End If
            On Error GoTo 0
            With ThisWorkbook.Sheets("Sheet1")
                .Range("A" & lngMyRow) = wb.Names("ACCNTNAME").RefersToRange
                .Range("B" & lngMyRow) = wb.Names("ACCNTNUM").RefersToRange
                .Range("C" & lngMyRow) = wb.Names("TOTALCOST").RefersToRange
            End With
            wb.Close False
        End If
    Next objFile
    
    Application.ScreenUpdating = True
 
End Sub

Regards,

Robert

 

[cweggleto81]

Keep getting this error when I try and run the macro, have set the path correctly and used the trailing \

"U:\New Charges\New Account SheetsFeel Unique.xlsx' cannot be found. Check your spelling, or try a different path.

Now I would assume this is because we are missing a \ between Sheets and Feel but the trailing \ IS in the code... confused

 

[Trebor76]

So you need to set the strFolderName variable like so:

strFolderName = "U:\New Charges\New Account Sheets"

 

[Trebor76]

Actually should be:

strFolderName = "U:\New Charges\New Account Sheets\"

 

[cweggleto81]

Hi,
The code does read strFolderName = "U:\New Charges\New Account Sheets" but I still get the same error. Any idea..

 

[cweggleto81]

Sorry, probably better I post the whole code.

Option Explicit
Sub Macro1()
    
    Dim objFSO As Object, objFolder As Object, objFile As Object
    Dim strFolderName As String
    Dim wb As Workbook
    Dim lngMyRow As Long
    
    Application.ScreenUpdating = False
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    strFolderName = "U:\New Charges\New Account Sheets\" '<-Foler containing Excel files. Remember trailing "\". Change to suit.
   
    Set objFolder = objFSO.GetFolder(strFolderName)
   
    For Each objFile In objFolder.Files
        If InStr(objFSO.GetExtensionName(objFile.Name), "xlsx") > 0 Then 'Only interested in Excel files
            Set wb = Workbooks.Open(objFolder & objFile.Name)
            'Puts the data from the named ranges into the next available row in columns A, B abd C in 'Sheet1'. Change to suit if necessary.
            On Error Resume Next 'In case there's no data in 'Sheet1' manually set the variable
                lngMyRow = ThisWorkbook.Sheets("Sheet1").Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                If lngMyRow = 0 Then
                    lngMyRow = 4 'Default initial output row number. Change to suit if necessary
                End If
            On Error GoTo 0
            With ThisWorkbook.Sheets("Sheet1")
                .Range("A" & lngMyRow) = wb.Names("ACCNTNAME").RefersToRange
                .Range("B" & lngMyRow) = wb.Names("ACCNTNUM").RefersToRange
                .Range("C" & lngMyRow) = wb.Names("TOTALCOST").RefersToRange
            End With
            wb.Close False
        End If
    Next objFile
    
    Application.ScreenUpdating = True
 
End Sub

So confused right now because it should work!

 

[Trebor76]

Try an extra trailing backslash \ (see post 6).

 

[cweggleto81]

Option Explicit
Sub Macro1()
    
    Dim objFSO As Object, objFolder As Object, objFile As Object
    Dim strFolderName As String
    Dim wb As Workbook
    Dim lngMyRow As Long
    
    Application.ScreenUpdating = False
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    strFolderName = "U:\New Charges\New Account Sheets\" '<-Foler containing Excel files. Remember trailing "\". Change to suit.
   
    Set objFolder = objFSO.GetFolder(strFolderName)
   
    For Each objFile In objFolder.Files
        If InStr(objFSO.GetExtensionName(objFile.Name), "xlsx") > 0 Then 'Only interested in Excel files
            Set wb = Workbooks.Open(objFolder & objFile.Name)
            'Puts the data from the named ranges into the next available row in columns A, B abd C in 'Sheet1'. Change to suit if necessary.
            On Error Resume Next 'In case there's no data in 'Sheet1' manually set the variable
                lngMyRow = ThisWorkbook.Sheets("Sheet1").Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                If lngMyRow = 0 Then
                    lngMyRow = 4 'Default initial output row number. Change to suit if necessary
                End If
            On Error GoTo 0
            With ThisWorkbook.Sheets("Sheet1")
                .Range("A" & lngMyRow) = wb.Names("ACCNTNAME").RefersToRange
                .Range("B" & lngMyRow) = wb.Names("ACCNTNUM").RefersToRange
                .Range("C" & lngMyRow) = wb.Names("TOTALCOST").RefersToRange
            End With
            wb.Close False
        End If
    Next objFile
    
    Application.ScreenUpdating = True
 
End Sub

This is what I have. I do have the extra trailing oblique.