VB Code to Create summary schedule by bringing schedule data from different sheet

Hi rmomin,

Try below code ...

Sub test()

Dim ws As Worksheet, Sh As Worksheet, Rg As Range
Set Sh = Sheets("FullSch")

For x = 6 To Sh.Range("A" & Rows.Count).End(3).Row
   For Each ws In Sheets(Array("LJ", "WE", "EL", "BN", "SO", "WO", "CW", "LB", "PC", "HO", "AP", "TN"))
      Set Rg = ws.Columns(2).Find(Sh.Cells(x, 1), lookat:=xlWhole, LookIn:=xlValues)
         If Not Rg Is Nothing Then
            For i = 1 To 7
               If Rg.Offset(, i).Value <> "." And Not IsEmpty(Rg.Offset(, i).Value) Then
                  Sh.Cells(x, 2).Offset(, i) = Rg.Offset(, i).Value & " " & ws.Name
               End If
            Next
         End If
      Set Rg = Nothing
   Next
Next

End Sub

Please try

Sub gat()
Dim sh As Worksheet, a, d As Object, r As Range, i As Long
Set d = CreateObject("Scripting.Dictionary")
ReDim a(1 To Sheets("FullSch").[C3].CurrentRegion.Columns.Count)
    For Each r In Sheets("FullSch").[A6].CurrentRegion
        d(r.Value) = a
    Next
    For Each sh In ThisWorkbook.Sheets
        If Len(sh.Name) = 2 Then
            For Each r In sh.Range("B6", sh.Cells(Rows.Count, 2).End(xlUp))
                If d.Exists(r.Value) Then
                    For i = 1 To UBound(a)
                        If Len(r.Offset(, i)) > 2 Then
                            a = d(r.Value)
                            a(i) = r.Offset(, i) & " " & sh.Name
                            d(r.Value) = a
                        End If
                    Next
                End If
            Next
        End If
    Next
a = Application.Transpose(Application.Transpose(d.items))
Sheets("FullSch").[C6].Resize(UBound(a), UBound(a, 2)) = a
End Sub

Glad to help & thanks for the Rep+

If that takes care of your question, please take a moment & mark the thread as [SOLVED] from the Thread Tools above your first post