[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub ImportData2Master_main()
Dim wbMaster As Workbook
Dim wb2CopyFrom As Workbook
Dim FSO As Object
Dim cFolder As Object
Dim cFile As Object
Dim cFiles As Object
Dim intLastRowMasterWb&
Dim intLastRowProcessedWb&
Dim intRowOffset&[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]On Error GoTo ErrorHandler[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the main folder which includes files which includes data to import
Const sMainFolderDir$ = "C:\Users\Sebastian\Desktop\FilesToImport"[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the number of worksheet in Master File where to import the data
Const wsSHEET2COPYTO% = 1[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the number of worksheet of import files from which the data will be imported
Const wsSHEET2COPYFROM% = 2[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the string range of first cell of the header in the master file
Const sHEADER_FIRST_CELL_MASTERFILE$ = "A1"[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the string of first cell on the header in the import files
Const sHEADER_FIRST_CELL_PROCESSEDFILE$ = "A10"[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'Set the constant no of columns which includes data for the import
Const int_NO_HEADER_COLUMNS% = 3[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Set wbMaster = ThisWorkbook
Set FSO = CreateObject("Scripting.FileSystemObject")
Set cFolder = FSO.GetFolder(sMainFolderDir)
Set cFiles = cFolder.Files[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]intLastRowMasterWb = 0
intLastRowProcessedWb = 0
intRowOffset = 0[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Application.ScreenUpdating = False[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]intLastRowMasterWb = wbMaster.Worksheets(wsSHEET2COPYTO).Cells(Cells.Rows.Count, Range(sHEADER_FIRST_CELL_MASTERFILE).Column).End(xlUp).Row[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'clear all previosly imported data before re-importing it from worksheets
wbMaster.Worksheets(wsSHEET2COPYTO).Range(Range(sHEADER_FIRST_CELL_MASTERFILE), Range(sHEADER_FIRST_CELL_MASTERFILE).Offset(intLastRowMasterWb - 1, int_NO_HEADER_COLUMNS - 1)).Clear[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
For Each cFile In cFiles
If (cFile.Name <> wbMaster.Name And cFile.Name Like "*" & wbMaster.Name = False) And (LCase(Right(cFile.Name, 3)) = "xls" Or LCase(Right(cFile.Name, 4)) = "xlsx" Or LCase(Right(cFile.Name, 4)) = "xlsm") Then
Set wb2CopyFrom = Workbooks.Open(sMainFolderDir & "\" & cFile.Name)[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]intLastRowMasterWb = wbMaster.Worksheets(wsSHEET2COPYTO).Cells(Cells.Rows.Count, Range(sHEADER_FIRST_CELL_MASTERFILE).Column).End(xlUp).Row
intLastRowProcessedWb = wb2CopyFrom.Worksheets(wsSHEET2COPYFROM).Cells(Cells.Rows.Count, Range(sHEADER_FIRST_CELL_PROCESSEDFILE).Column).End(xlUp).Row[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]If intLastRowMasterWb = 1 Then
intRowOffset = 0
Else
intRowOffset = 1
End If[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]wb2CopyFrom.Worksheets(wsSHEET2COPYFROM).Range(wb2CopyFrom.Worksheets(wsSHEET2COPYFROM).Range(sHEADER_FIRST_CELL_PROCESSEDFILE).Offset(intRowOffset, 0), wb2CopyFrom.Worksheets(wsSHEET2COPYFROM).Range(sHEADER_FIRST_CELL_MASTERFILE).Offset(intLastRowProcessedWb - 1, int_NO_HEADER_COLUMNS - 1)).Copy Destination:=wbMaster.Worksheets(wsSHEET2COPYTO).Cells(intLastRowMasterWb + intRowOffset, Range(sHEADER_FIRST_CELL_MASTERFILE).Column)
wb2CopyFrom.Close[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]End If
Next cFile[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]MsgBox "Done"[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]clearance:
On Error Resume Next
Set wbMaster = Nothing
Set FSO = Nothing
Set cFolder = Nothing
Set cFiles = Nothing
Application.ScreenUpdating = True[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Exit Sub
ErrorHandler:
Debug.Print "Error: "
Resume clearance[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]End Sub
[CODE/]
[/FONT]