vba - 間に空のセルがある場合、データを複数のワークシートに分割するvba

Question

間に空白のセルがある場合、データを追跡するのに問題があります。2 つの空のセル k7 と k8 があるため、k9 以降のデータを追跡できません。セル A から K までのデータがあります。セル K は、新しいシートの主要な要素と名前です。セル A から J は、名前、時間、オフィスなどのその他のデータです。セル A2 から K2 は見出しになります。セルはシート A、B、C に分割されます。

Department  <-- this is K2

A     <--- this K4
B
C      
       <---k7
       <---k8

B      <---k9
B

C     


A    <-- this is K14

これは私のコードです

Private Sub CommandButton1_Click()

Dim ws As Worksheet, Rng As Range, cc
Dim temp As Worksheet, CostC As Range, u

Set ws = Sheets("Sheet1") 'where your original data. adjust to suit
Set Rng = ws.Range("a1").CurrentRegion.Resize(, 15)
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 15) '<<add
Set CostC = ws.Range("k4", ws.Range("k" & Rows.Count).End(xlUp))

u = UNIQUE(CostC)
Application.ScreenUpdating = 0
For Each cc In u
    With Rng
        .AutoFilter field:=11, Criteria1:="=" & cc
        On Error Resume Next
        Set temp = Sheets(cc)
        On Error GoTo 0
        If Not temp Is Nothing Then

DoThis:

        .SpecialCells(xlCellTypeVisible).Copy temp.Range("A1")
        Else
            Set temp = Sheets.Add
            temp.Name = cc
            GoTo DoThis
        End If
        .AutoFilter
    End With
    Set temp = Nothing
Next
Application.ScreenUpdating = 1

End Sub

Function UNIQUE(r As Range)
Dim a, v
If IsArray(r.Value) Then
    a = r.Value
    With CreateObject("scripting.dictionary")
        .comparemode = vbTextCompare
        For Each v In a
            If Not IsEmpty(v) Then
                If Not .exists(v) Then .Add v, Nothing
            End If
        Next
        If .Count > 0 Then UNIQUE = .keys
    End With
    Erase a
Else
    UNIQUE = r.Value
End If

End Function