Sub merge_files()
'In this subroutine there are our inputs required
' path- where all xls are stoted [ThisWorkbook.Path - all are in same folder]
'xl file type - which excel's are to process as there are several xl format depending on the req, so that in which format data u have
'write each sheet name with seprated by "|", [A|B|C|D]
'write relevent sheet data range & same order
merge_xl_V_2 ThisWorkbook.Path, "*.xlsx", "Risk Log|Issue Log", "C8:T2000|C10:Q2000"
End Sub
Sub merge_xl_V_2(strsoucefolder As String, xlfiles As String, sheetname As String, copyrnage As String)
'Declare variable
Dim strfiles As String, openworkbook As Workbook, copy_rows As Integer, copy_rng As Range, myXL As String
'As sheet name & range are in a array type string so get it splitted
Dim strsheet1 As String: strsheet1 = Split(sheetname, "|")(0)
Dim strsheet2 As String: strsheet2 = Split(sheetname, "|")(1)
Dim rng1 As String: rng1 = Split(copyrnage, "|")(0)
Dim rng2 As String: rng2 = Split(copyrnage, "|")(1)
'first row where to paste,two variable for two sheet as both have diff ranges
Dim s As Integer: s = 2
Dim s1 As Integer: s1 = 2
'Check & add path sep
If Right(strsoucefolder, 1) <> "\" Then strsoucefolder = strsoucefolder & "\"
'check that in given path Excel's with asked extention are available or not
strfiles = Dir(strsoucefolder & xlfiles)
If strfiles = "" Then MsgBox "No XL Files found!!!", vbCritical: Exit Sub
'turn off screen updating to fast the process
Application.ScreenUpdating = False
'strat loop for each xl
Do While strfiles <> ""
'skip thisworkbook
myXL = strsoucefolder & strfiles
If Not myXL <> ThisWorkbook.Name Then GoTo L2
'open xl
Set openworkbook = Workbooks.Open(myXL)
'check if it have the asked sheet
If Evaluate("ISREF('" & strsheet1 & "'!A1)") Then
With openworkbook.Sheets(strsheet1).Range(rng1)
'how many rows to be copied, here i have taken it from col D which is just 2nd col of the range C8:T2000
copy_rows = WorksheetFunction.CountA(.Columns(2))
'set range to copy
Set copy_rng = .Resize(copy_rows)
End With
copy_rng.Copy
'paste the range with format too
With ThisWorkbook.Sheets(strsheet1).Cells(s, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
'clear clipboard
Application.CutCopyMode = False
End If
'same thing for another sheet
If Evaluate("ISREF('" & strsheet2 & "'!A1)") Then
With openworkbook.Sheets(strsheet2).Range(rng2)
'how many rows to be copied, here i have taken it from col K which is just 9th col of the range C10:Q2000
copy_rows1 = WorksheetFunction.CountA(.Columns(9))
Set copy_rng = .Resize(copy_rows1)
End With
copy_rng.Copy
With ThisWorkbook.Sheets(strsheet2).Cells(s1, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End If
'close the workbook without save
openworkbook.Close 0
'change, now where to copy from next file
s = s + copy_rows: s1 = s1 + copy_rows1
L2:
'loop to another file
strfiles = Dir
Loop
'strat screen update
Application.ScreenUpdating = True
End Sub
