求助按列拆分

jian82372387

求助：附件分别以物流表的B列内容拆分成多个工作表的相应数据，再以F列内容拆分成多个工作表的相应数据，除了物流表外其他拆分出来的工作表以H列时间排序（升序扩展区域）,要将带相同仓库名字的B列和F列拆分出来的的数据放在同一个工作表里面，隔开一行 ，并加上标题，字体加粗，居中，外粗边框，  内部细边框。   例：标橙色工作表A仓库的数据    ，请问有办法解决吗？？      

下面是之前请教他人分别拆分的代码：（但是同一仓库的无法放再同一个工作表 ）
Sub 按列拆分()
   Set d1 = CreateObject("Scripting.Dictionary")
   Set d2 = CreateObject("Scripting.Dictionary")
   a = Sheets("物流表").[a2].CurrentRegion
   For i = 3 To UBound(a)
      key1 = Trim(a(i, 2)) & "出发"
      Key2 = Trim(a(i, 6)) & "下班"
      If Not d1.exists(key1) Then Set d1(key1) = CreateObject("Scripting.Dictionary")
      If Not d2.exists(Key2) Then Set d2(Key2) = CreateObject("Scripting.Dictionary")
      d1(key1)(i) = 1: d2(Key2)(i) = 1
   Next

   For Each Key In d1.keys
      If Evaluate("ISREF('" & Key & "'!A1)") = 0 Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = Key
      With Sheets(Key)
         .[a1:k1] = [{"班号","车型","车牌号"，"开始单号","司机","副司机","学徒","上班时间","工号","打卡时间","出发地点"}]
         .[a3:n1000].ClearContents
         r = 2
         For Each Row In d1(Key)
            r = r + 1
         
           .Cells(r, 1) = Array(a(Row, 1))
           .Cells(r, 4) = Array("'" & a(Row, 4))
           .Cells(r, 8) = Array(a(Row, 3))
           .Cells(r, 11) = Array(a(Row, 2))
         Next
      End With
   Next

   For Each Key In d2.keys
      If Evaluate("ISREF('" & Key & "'!A1)") = 0 Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = Key
      With Sheets(Key)
         .[a1:k1] = [{"班号","车型","车牌号"，"结束单号","司机","副司机","学徒","下班时间","工号","打卡时间","下班地点"}]
         .[a3:n1000].ClearContents
         r = 2
         For Each Row In d2(Key)
            r = r + 1
         
            .Cells(r, 1) = Array(a(Row, 1))
           .Cells(r, 4) = Array("'" & a(Row, 8))
           .Cells(r, 8) = Array(a(Row, 7))
           .Cells(r, 11) = Array(a(Row, 6))
         Next
      End With
   Next

End Sub
     顺便请教一下上述代码红色那句的意思吗？