エクセルＶＢＡで返品了解書を作成。書誌データを出版社別に処理する

「Ｄｉｃｔｉｏｎａｒｙオブジェクト」・・・・・myDic

「出版社名」・・・・・SyuN

'変数宣言
Dim s As Long
Dim t As Long
Dim tyuRow As Long
Dim SyuN As Variant
Dim myDic As Dictionary

Set myDic = New Dictionary

'出版社名を送る
Worksheets("抽出データ").Select
  Aho = Worksheets("抽出データ").Range("C2").Value
  tyuRow = Cells(Rows.Count, 2).End(xlUp).Row
  For s = 1 To tyuRow
    SyuN = Cells(s, 3).Value
    If myDic.Exists(SyuN) = False Then
      myDic.Add SyuN, ""
    End If
  Next s

Worksheets("出版社リスト").Select
  For t = 1 To myDic.Count - 1
    Cells(t, 1).Value = myDic.Keys(t)
  Next t

End Sub

Sub 出版社シート()

Dim SyuRow As Long
Dim SN As Variant
Dim t As Long

Worksheets("出版社リスト").Select
  SyuRow = Cells(Rows.Count, 1).End(xlUp).Row
  For t = 1 To SyuRow
    SN = Range("A" & t).Value
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = SN
  Worksheets("出版社リスト").Select
  Next t

End Sub

Sub 出版社振り分け()

Dim SyuRow As Long
Dim SN As Variant
Dim s As Long
Dim t As Long
Dim n As Long

Worksheets("出版社リスト").Select
  SyuRow = Cells(Rows.Count, 1).End(xlUp).Row
  For t = 1 To SyuRow
    SN = Range("A" & t).Value
    Worksheets("抽出データ").Select
    tyuRow = Cells(Rows.Count, 3).End(xlUp).Row
    s = 1
    For n = 1 To tyuRow
      If Range("C" & n).Value = SN Then
        Rows(n).Copy Destination:=Worksheets(SN).Range("A" & s)
        s = s + 1
        Worksheets(SN).Columns("A:G").AutoFit
      End If
      Worksheets("抽出データ").Select
    Next n
    Worksheets("出版社リスト").Select
  Next t

End Sub

Sub 返品書誌データ整理()
Worksheets("抽出データ").Select
  R = Cells(Rows.Count, 2).End(xlUp).Row
  If R <= 1 Then
      MsgBox "返品データが取り出されていません！"
      Worksheets("操作ボタン").Select
      Range("A1").Select
      Exit Sub
  End If
  出版社名リストアップ
  出版社シート
  出版社振り分け

End Sub