importing specific columns / sheet names from a file location

[hissonrr]

Good day all,

I am using this script below and was wondering if anyone could help me out altering a bit as my VBA knowledge is lacking.

I need it to just import column E and A from the specific files as well as add the file name to the import.

Is this possible?

Any help would be appreciated and thanks

Sub Consolidate()'Author:     Jerry Beaucaire'
'Date:       9/15/2009     (2007 compatible)  (updated 4/29/2011)
'Summary:    Merge files in a specific folder into one master sheet (stacked)
'            Moves imported files into another folder


Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet


'Setup
    Application.ScreenUpdating = False  'speed up macro execution
    Application.EnableEvents = False    'turn off other macros for now
    Application.DisplayAlerts = False   'turn off system messages for now
    
    Set wsMaster = ThisWorkbook.Sheets("Robs")    'sheet report is built into


With wsMaster
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        .UsedRange.Offset(1).EntireRow.Clear
        NR = 2
    Else
        NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
    End If


'Path and filename (edit this section to suit)
    fPath = "Q:\Shared\1Sweetie Peck - BKR\Geology\Brady K\WB Correlation Data from Caitlin\Middle LZ\WB_MLZ_175A_75B_Average_By_Polygon\WB_MLZ_175A_75B_Average_By_Polygon\"            'remember final \ in this string
    fPathDone = fPath & "Imported\"     'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                 'creates the completed folder if missing
    On Error GoTo 0
    fName = Dir(fPath & "*.CSV*")        'listing of desired files, edit filter as desired


'Import a sheet from found files
    Do While Len(fName) > 0
        If fName <> ThisWorkbook.Name Then              'don't reopen this file accidentally
            Set wbData = Workbooks.Open(fPath & fName)  'Open file


        'This is the section to customize, replace with your own action code as needed
            LR = Range("A" & Rows.Count).End(xlUp).Row  'Find last row
            Range("A3:A" & LR).EntireRow.Copy .Range("A" & NR)
            wbData.Close False                                'close file
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
            Name fPath & fName As fPathDone & fName           'move file to IMPORTED folder
        End If
        fName = Dir                                       'ready next filename
    Loop
End With


ErrorExit:    'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
End Sub

 

[tonyyy]

hissonrr,

You might consider the following...

Sub Consolidate() 'Author:     Jerry Beaucaire'
'Date:       9/15/2009     (2007 compatible)  (updated 4/29/2011)
'Summary:    Merge files in a specific folder into one master sheet (stacked)
'            Moves imported files into another folder


Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet


'Setup
    Application.ScreenUpdating = False  'speed up macro execution
    Application.EnableEvents = False    'turn off other macros for now
    Application.DisplayAlerts = False   'turn off system messages for now
    
    Set wsMaster = ThisWorkbook.Sheets("Robs")    'sheet report is built into


With wsMaster
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        .UsedRange.Offset(1).EntireRow.Clear
        NR = 2
    Else
        NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
    End If


'Path and filename (edit this section to suit)
    fPath = "Q:\Shared\1Sweetie Peck - BKR\Geology\Brady K\WB Correlation Data from Caitlin\Middle LZ\WB_MLZ_175A_75B_Average_By_Polygon\WB_MLZ_175A_75B_Average_By_Polygon\"            'remember final \ in this string
    fPathDone = fPath & "Imported\"     'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                 'creates the completed folder if missing
    On Error GoTo 0
    fName = Dir(fPath & "*.CSV*")        'listing of desired files, edit filter as desired


'Import a sheet from found files
    Do While Len(fName) > 0
        If fName <> ThisWorkbook.Name Then              'don't reopen this file accidentally
            Set wbData = Workbooks.Open(fPath & fName)  'Open file


        'This is the section to customize, replace with your own action code as needed
            LR = Range("A" & Rows.Count).End(xlUp).Row  'Find last row
'            Range("A3:A" & LR).EntireRow.Copy .Range("A" & NR)
            Range("A3:A" & LR).Copy .Range("A" & NR) 'Copy Column A
            Range("E3:E" & LR).Copy .Range("E" & NR) 'Copy Column E
            .Range("F" & NR).Value = fName 'Add file name in Column F
            
            wbData.Close False                                'close file
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
            Name fPath & fName As fPathDone & fName           'move file to IMPORTED folder
        End If
        fName = Dir                                       'ready next filename
    Loop
End With


ErrorExit:    'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
End Sub

Cheers,

tonyyy

 

[hissonrr]

Worked great thanks you.

 

[tonyyy]

You're very welcome...