Need VBA to open multiple sheets, copy, and paste certain values

[thejohn11]

Hey Guys,
I know you have gotten this one a bunch before, but I can't find a way to do the couple things I need this to do. I'm really close however, so it shouldn't take more than 5 minutes hopefully.

What I need.
Open multiple files at one time, copy and paste certain cells in those files, to the corresponding cells in my master file. It cannot overwrite the old data lines, it simply needs to paste the new information in the master below the old information. Then close the files.

here's what I have so far, this code works... it's missing 2 things.
Does not open multiple files and does not paste new information below old information.

Sub ImportData()
Dim strFile As String
MsgBox "Select Expense Reports"
strFile = Application.GetOpenFilename("Excel-files,*.xlsm ; *.xls ; *.xlsx", _
1, "Select Expense Reports", , False)
If strFile = "False" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim oWorkBook As Workbook
Dim oSheet As Worksheet
Dim oMaster As Worksheet
Dim i As Long
On Error Resume Next
Set oMaster = ThisWorkbook.Worksheets("Master")
Set oWorkBook = Workbooks.Open(strFile, ReadOnly:=True)
Set oSheet = oWorkBook.Worksheets("End Report")
ThisWorkbook.Save
i = oMaster.Cells.SpecialCells(xlCellTypeLastCell).Row
If i > 1 Then
oMaster.Range("A:J" & i).Interior.Pattern = xlNone
End If
i = oSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
oMaster.Range("A4").Value = oSheet.Range("C13").Value
oMaster.Range("B4").Value = oSheet.Range("F8").Value
oMaster.Range("C4").Value = oSheet.Range("F9").Value
oMaster.Range("D4").Value = oSheet.Range("C9").Value
oMaster.Range("E4").Value = oSheet.Range("C10").Value
oMaster.Range("F4").Value = oSheet.Range("C14").Value
oMaster.Range("G4").Value = oSheet.Range("C16").Value
oMaster.Range("H4").Value = oSheet.Range("C17").Value
oMaster.Range("I4").Value = oSheet.Range("C18").Value
oMaster.Range("J4").Value = oSheet.Range("C19").Value
oMaster.Range("K4").Value = oSheet.Range("C20").Value
oMaster.Range("L4").Value = oSheet.Range("C22").Value
oMaster.Range("M4").Value = oSheet.Range("F12").Value
oWorkBook.Close (False)
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub


Please Help
Thank you!

 

[elderL]

Thank you. Final working code is

Option Explicit

Sub Import_Expense_Reports()
Dim fNAME As String, fPATH As String
Dim oWorkBook As Workbook, NR As Long
Dim oMaster As Worksheet, oSheet As Worksheet

MsgBox "Select Expense Reports Folder"
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count > 0 Then
        fPATH = .SelectedItems(1) & "\"
    Else
        Exit Sub
    End If
End With

Application.ScreenUpdating = False
Application.DisplayAlerts = False
    
Set oMaster = ThisWorkbook.Worksheets("Master")

' Hardcode to beginning of sheet.  NR is row index:
NR = oMaster.Range("A" & Rows.Count).End(xlUp).Row

fNAME = Dir(fPATH & "*.xl*")            'finds any Excel file in chosen folder

Do While Len(fNAME) > 0
    Set oWorkBook = Workbooks.Open(fPATH & fNAME, ReadOnly:=True)
    Set oSheet = oWorkBook.Worksheets("End Report")
    If NR > 1 Then oMaster.Range("A" & NR).Resize(, 10).Interior.Pattern = xlNone
    oMaster.Range("A" & NR).Value = oSheet.Range("C13").Value
    oMaster.Range("B" & NR).Value = oSheet.Range("F8").Value
    oMaster.Range("C" & NR).Value = oSheet.Range("F9").Value
    oMaster.Range("D" & NR).Value = oSheet.Range("C9").Value
    oMaster.Range("E" & NR).Value = oSheet.Range("C10").Value
    oMaster.Range("F" & NR).Value = oSheet.Range("C14").Value
    oMaster.Range("G" & NR).Value = oSheet.Range("C16").Value
    oMaster.Range("H" & NR).Value = oSheet.Range("C17").Value
    oMaster.Range("I" & NR).Value = oSheet.Range("C18").Value
    oMaster.Range("J" & NR).Value = oSheet.Range("C19").Value
    oMaster.Range("K" & NR).Value = oSheet.Range("C20").Value
    oMaster.Range("L" & NR).Value = oSheet.Range("C22").Value
    oMaster.Range("M" & NR).Value = oSheet.Range("F12").Value
    oWorkBook.Close (False)
    NR = NR + 1
        
    fNAME = Dir         'get next filename with same filter
Loop                    'repeat until no more filenames

ThisWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Hi There, I am utilising part of your great macro but I have a variable which is different. I am wondering if could help me. In effect I have to set of data that I would need to get from multiple files in a folder and copy them into a master file. The type of data can change but I will always follow the same type of structure. The first row contains the column titles and the second row contains the variable data that I would need to increment on a master file.
I have no problems in incrementing the file but I have problems in making the first row the titles row. The macro ovewrites the first line of a variable data.

The code I have modified is a follow. Could you help?

Option Explicit


Sub Import_Expense_Reports()
Dim fNAME As String, SourcePATH As String, OuputPATH As String
Dim oWorkBook As Workbook, NR As Long
Dim oMaster As Worksheet, oSheet As Worksheet


' select source path


MsgBox "Select the source Folder"
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count > 0 Then
        SourcePATH = .SelectedItems(1) & "\"
    Else
        Exit Sub
    End If
End With
' end select source path


' select output path


MsgBox "Select the output Folder"
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count > 0 Then
        OuputPATH = .SelectedItems(1) & "\"
    Else
        Exit Sub
    End If
End With


' end select output path


Application.ScreenUpdating = False
Application.DisplayAlerts = False


' source range
    
Set oMaster = ThisWorkbook.Worksheets("Master")


' Hardcode to beginning of sheet.  NR is row index:
'NR = oMaster.Range("B" & Rows.Count).End(xlUp).Row
NR = oMaster.Range("B2").End(xlUp).Row


fNAME = Dir(SourcePATH & "*.xl*")            'finds any Excel file in chosen folder


Do While Len(fNAME) > 0
    Set oWorkBook = Workbooks.Open(SourcePATH & fNAME, ReadOnly:=True)
    
   Set oSheet = oWorkBook.Worksheets("Output")
    If NR > 1 Then oMaster.Range("B" & NR).Resize(, 10).Interior.Pattern = xlNone
    'oMaster.Range("A" & NR).Value = oSheet.Range("A2:CJ2").Value
    oMaster.Range("A1:CC1").Value = oSheet.Range("A1:CC1").Value
    oMaster.Range("A" & NR, "CC" & NR).Value = oSheet.Range("A2:CC2").Value
    
    oWorkBook.Close (False)
    NR = NR + 1
         
    fNAME = Dir         'get next filename with same filter
Loop                    'repeat until no more filenames


ThisWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub