Combine multiple excel sheets into one excel sheet

hkaur

New Member
Joined
Aug 22, 2013
Messages
1
Dear Friends,

Can someone help me with below? How can I modify below code to consolidate 8 data files into 1 file using a similar setup as "SplitRpt" .
Please help me in this context since I am incompetent in VBA programming. :( Let me know if you require additional details. This is very urgent for me
sad2.gif
Code:
Private Sub SplitRptByPackage() 
    Dim fXLSFile As String 
     'Dim nRow As Integer
    Dim iRow As Integer 
    Dim custcode As String 
    Dim colvalue As String 
    Dim coltitle As String 
    Dim site_cnt As Integer 
    Dim site_name As String 
    Dim colDest As String 
    Dim ext_rpt As Worksheet 
    Dim wip_rpt As Worksheet 
    Dim CustWIP As String, tCustWIP As String 
     ' Loop for 2 sites
    For site_cnt = SiteStart To SiteCount 
        If site_cnt = 1 Then 
            site_name = "M" 
            webwipext_txt = WEBWIPEXT_TXT_M 
            If Not fMOK Then Goto skipNextSite 
        Else 
            site_name = "S" 
            webwipext_txt = WEBWIPEXT_TXT_S 
            If Not fSOK Then Goto skipNextSite 
        End If 
         ' WIP report name
        If vTestRun Then 
            fXLSFile = site_name & pfName & "_" & TestRunSession & ".xls" 
        Else 
            fXLSFile = site_name & pfName & ".xls" 
        End If 
         
         ' Workplace worksheet
        Worksheets("SplitRpt").Select 
        Set ext_rpt = ActiveWorkbook.ActiveSheet 
         
         ' Get the Split info customer list start row
        iRow = 2 
        nVal1 = 0 
         ' Loop until end of the list
        Do Until ext_rpt.Cells(iRow, 1) = "" 
             ' Get setup info from SplitRpt worksheet
            custcode = ext_rpt.Cells(iRow, 1) 
            coltitle = ext_rpt.Cells(iRow, 2) 
            colvalue = ext_rpt.Cells(iRow, 3) 
            colFilename = ext_rpt.Cells(iRow, 4) 
            nVal1 = InStr(1, colvalue, ",") 
            If nVal1 > 0 Then 
                colPkg = Mid(colvalue, 1, nVal - 1) 
            Else 
                colPkg = Trim(colvalue) 
            End If 
             ' Skip other customer code if not in cust list (manual run only)
            If manual_by_cust <> "" And InStr(manual_by_cust, custcode) = 0 Then Goto skipNextCust 
             
             ' Open Customer WIP which need to split if exist otherwise skip to next customer
            CustWIP = FDIR & custcode & "\" & fXLSFile 
            If Not FileExists(CustWIP) Then Goto skipNextCust 
            Debug.Print "UpdExtInfo:: " & custcode & " for " & site_name & "-Site" 
             ' Open customer WIP
            Workbooks.Open filename:=CustWIP 
             ' WIP worksheet
            Set wip_rpt = ActiveWorkbook.ActiveSheet 
             
            colDest = "*" & colPkg & "*" 
            If findColumn(colDest, wip_rpt) > 0 Then 
                Application.DisplayAlerts = False 
                SaveFileName = site_name & pfName & colFilename & ".xls" 
                SaveAsFileName = FDIR & custcode & "\" & SaveFileName 
                ActiveWorkbook.SaveAs filename:=SaveAsFileName, FileFormat:=xlExcel5, _ 
                Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False 
                 
                Windows(SaveFileName).Activate 
                Set cust_rpt = ActiveWorkbook.ActiveSheet 
                 
                 '-- Loop to remove unwanted pacakge
                l_cnt = 11 
                Do Until cust_rpt.Cells(l_cnt, 1) = "DEFINITIONS OF TERMS:" 
                    If (cust_rpt.Cells(l_cnt, 3) Like colDest) Or _ 
                    (cust_rpt.Cells(l_cnt, 3) = "") Or _ 
                    (cust_rpt.Cells(l_cnt, 3) = "Grand Total") Then 
                        Cells(l_cnt, 30) = "" 
                    Else 
                        If (cust_rpt.Cells(l_cnt, 3) = "TBA") Then 
                            nVal1 = 0 
                            nVal1 = InStr(1, cust_rpt.Cells(l_cnt, 4), "-" & colPkg) 
                            If nVal1 > 0 Then 
                                Cells(l_cnt, 30) = "" 
                            Else 
                                nVal1 = 0 
                                nVal2 = 0 
                                nVal1 = InStr(1, cust_rpt.Cells(l_cnt, 4), "-SC70") 
                                nVal2 = InStr(1, cust_rpt.Cells(l_cnt, 4), "-SOT") 
                                If (nVal1 = 0 And nVal2 = 0) And colPkg = "SC70" Then 
                                    Cells(l_cnt, 30) = "" 
                                Else 
                                    Cells(l_cnt, 30) = "DEL" 
                                End If 
                            End If 
                        Else 
                            If (cust_rpt.Cells(l_cnt, 3) = "TBA Total") Then 
                                Cells(l_cnt, 30) = "" 
                            Else 
                                Cells(l_cnt, 30) = "DEL" 
                            End If 
                        End If 
                    End If 
                    l_cnt = l_cnt + 1 
                Loop 
                 
                 '-- Perform deletion
                l_cnt = 11 
                Do Until cust_rpt.Cells(l_cnt, 1) = "DEFINITIONS OF TERMS:" 
                    If cust_rpt.Cells(l_cnt, 30) = "DEL" Then 
                        vAdd = l_cnt & ":" & l_cnt 
                        Rows(vAdd).Select 
                        Selection.Delete Shift:=xlUp 
                        l_cnt = l_cnt - 1 
                    End If 
                    l_cnt = l_cnt + 1 
                Loop 
                 
                 'Close the wip repot
                cust_rpt.Select 
                ActiveWorkbook.Save 
                ActiveWorkbook.Close 
            Else 
                ActiveWorkbook.Close 
            End If 
skipNextCust: 
            iRow = iRow + 1 
        Loop 
skipNextSite: 
    Next site_cnt 
End Sub
**************************
"SplitRpt" Sheet Content

CUST SPLIT BY VALUE APPEND_FILENAME REMARK
AVG PKG SC70 _SC70
AVG PKG SOT _SOT

Suggesting setup as below :
Every cust has one folder each with its own data. Need to consolidate all 8 cust excel sheet into 1 sheet by maintaining the existing folders and data for each cust. Which means every cust folder will still have separate cust data but under each folder will also have an additional sheet of the consolidated version.How can I modify the above code to achieve this?

CUST APPEND_FILENAME
SGC _ST
SGG _ST
SGF _ST
SGS _ST
SGT _ST
SGE _ST
SGU _ST
SGR _ST

Thank you in advance.
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Forum statistics

Threads
1,221,310
Messages
6,159,176
Members
451,543
Latest member
cesymcox

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top