• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Need to split multiple sheets in a workbook to separate sheets with a commom column in each sheet

imdadullah@1983

New Member
Attached excel workbook has multiple sheet. Each sheet has a different parameter

Need new workbook to be created with the name taken from the Location example Mumbai as one workbook and all the data pertaining to Mumbai has to be filtered from Master work book and paste it in new work book call Mumbai .

The Mumbai work book should has all three sheet separately and should have detailed of Mumbai location only

When i open the Mumbai file it should have all the three sheets naming ( employee details , employee skills ,experience ) only Mumbai location details should be their
 

Attachments

jolivanes

Member
Code:
Sub Maybe()
Dim arr, r
Dim sh1 As Worksheet
Dim svName As String
Dim j As Long, i As Long, k As Long
Application.ScreenUpdating = False
Set sh1 = Sheets("Employee details")
arr = sh1.Range("B3:B" & sh1.Cells(Rows.Count, 2).End(xlUp).Row).Value

    With CreateObject("Scripting.Dictionary")
        For Each r In arr
            If Not .exists(r) Then .Add r, Empty
        Next r
    arr = .keys()
    End With
    
    For j = LBound(arr) To UBound(arr)
        svName = ThisWorkbook.Path & "\" & arr(j) & ".xlsx"
        Sheets(Array("Employee details", "Employee Skills", "Experience")).Copy
            With ActiveWorkbook
                For i = 1 To 3
                    For k = .Sheets(i).Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
                        If .Sheets(i).Cells(k, 2).Value <> arr(j) Then .Sheets(i).Cells(k, 2).EntireRow.Delete
                    Next k
                Next i
            Application.DisplayAlerts = False
                .SaveAs Filename:=svName, FileFormat:=51
            Application.DisplayAlerts = True
            .Close
            End With
    Next j
Application.ScreenUpdating = True
End Sub
BTW, you have a trailing space in sheet name "Experience "
That needs to be deleted. Any spelling differences/mistakes will cause an error in the code.
 
Top