Copy Data From Multiple Workbooks To A Master Workbook

Hi all

I have an excel (2010) workbook which contains 1 worksheet called MASTER. This sheet has the headers starting in A1 through E1:

Date
Company Name
Contact
TorV
Details

I want a VBA script that will run from the MASTER worksheet and allow me to select multiple workbooks in a folder and copy the data (from ROW 22) until LAST ROW and add it to the worksheet called MASTER.

I already have a VBA script (shown below so that other users can use) which allows me to select multiple workbooks in a folder and pull out individual cells data but I need to change the script to pull out ROWS data as per the paragraph above.

I have just got back off holiday and my mind is blank as to how to change the script

Many Thanks


Craig:

Code:

---

Sub BulkImport()
  Dim InFileNames As Variant
  Dim OutFileName As String
  Dim fCtr As Long
  Dim tempWkbk As Workbook
  Dim consWks As Worksheet
  Dim destCell As Range
  Dim myRow As Long
  Dim total As Long
  Dim LastRow As Long
  Set consWks = ActiveWorkbook.Sheets(1)
  LastRow = consWks.Range("A65536").End(xlUp).Row
  InFileNames = Application.GetOpenFilename _
  (FileFilter:="Excel Files, *.xl*", MultiSelect:=True)
  Application.ScreenUpdating = False
  If IsArray(InFileNames) Then
      For fCtr = LBound(InFileNames) To UBound(InFileNames)
        Set tempWkbk = Workbooks.Open(Filename:=InFileNames(fCtr))
        consWks.Range("A" & fCtr + LastRow).Value = tempWkbk.Worksheets(1).Range("A22").Value
        consWks.Range("B" & fCtr + LastRow).Value = tempWkbk.Worksheets(1).Range("B22").Value
        consWks.Range("C" & fCtr + LastRow).Value = tempWkbk.Worksheets(1).Range("C22").Value
        consWks.Range("D" & fCtr + LastRow).Value = tempWkbk.Worksheets(1).Range("D22").Value
        consWks.Range("E" & fCtr + LastRow).Value = tempWkbk.Worksheets(1).Range("E22").Value
      ActiveWorkbook.Close
      Next fCtr
  Else
      MsgBox "No file selected"
  End If
  With Application
      .StatusBar = False
      .ScreenUpdating = True
  End With
End Sub

---

try this..

Code:

---

Sub BulkImport()

  Dim InFileNames As Variant
  Dim fCtr As Long
  Dim tempWkbk As Workbook
  Dim consWks As Worksheet
  Set consWks = ThisWorkbook.Sheets(1)
  InFileNames = Application.GetOpenFilename _
  (FileFilter:="Excel Files, *.xl*", MultiSelect:=True)
  Application.ScreenUpdating = False
  If IsArray(InFileNames) Then
      For fCtr = LBound(InFileNames) To UBound(InFileNames)
        With Workbooks.Open(Filename:=InFileNames(fCtr))
            .Sheets(1).Range("A22:E" & .Sheets(1).Range("A" & .Sheets(1).Rows.Count).End(xlUp).Row).Copy consWks.Range("A" & consWks.Rows.Count).End(xlUp)(2)
            .Close 0
        End With
      Next fCtr
  Else
      MsgBox "No file selected"
  End If
  With Application
      .StatusBar = False
      .ScreenUpdating = True
  End With
 
End Sub

---

Thank you Excel Fox for the script - which works exactly as I envisaged it would.

I also realise that I was declaring names that were not needed in the original script. I use the original script for copying data from Excel quote Forms onto an excel master quotation log.:)

Thank you again.