1つのエクセルを項目ごとに分割して別ファイルへ

質問

以前質問・回答のあったこちらを参考にマクロをさくせいしました。
https://sp.okwave.jp/qa/q3291205.html

このうちの下記のマクロなのですが、こちらを少しアレンジしたいと考えております。
項目の分割をA列→C列に変更
さらに、分割したファイルに違う作業を加えたいのですが、どこを変更してどこに追加をしたら良いか教えていただけないでしょうか。
マクロ初心者なので、基本的な質問ですみません。

Sub Test()
Dim wb As Workbook, tws As Worksheet, r As Range
Dim myList As New Collection, fPath As String

On Error Resume Next

fPath = ActiveWorkbook.Path & "\"
Set tws = ActiveSheet

With tws

　　For Each r In .Range(.Range("A2"), .Range("A65536").End(xlUp))
　　　　myList.Add r.Value, CStr(r.Value)
　　Next r

　　.Range("A1").AutoFilter
　　If Not .AutoFilterMode Then .Range("A1").AutoFilter

　　For i = 1 To myList.Count
　　　　Set wb = Workbooks.Add(xlWBATWorksheet)
　　　　.Range("A1").AutoFilter field:=1, Criteria1:=myList(i)
　　　　.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
　　　　　　　　　　 Destination:=wb.Worksheets(1).Range("A1")
　　　　wb.SaveAs Filename:=fPath & myList(i) & ".xls"
　　Next i

　　.Range("A1").AutoFilter

End With

Set myList = Nothing

End Sub

回答No.1

HohoPapa

示されたコードを、
C列に埋まっている文字列で分解するコードに変更してみました。
よかったら参考にしてください。

※０　C列に変えるために変更した箇所
※１　変数の定義が足りないようなので追加
※２　分解後のシートを保存する前に加工する例
※３　保存する拡張子を　今仕様のxlsxに変更
※４　分解後のブックを保存しているものの閉じていないので加筆

Sub Test()

　Dim wb As Workbook, tws As Worksheet, r As Range
　Dim myList As New Collection, fPath As String
　Dim i As Integer　　　　　　　　　　　　　　　　　　　'<<< ※１
　On Error Resume Next

　fPath = ActiveWorkbook.Path & "\"
　Set tws = ActiveSheet

　With tws

　　For Each r In .Range(.Range("C2"), .Range("C65536").End(xlUp))　'<<< ※０
　　　　myList.Add r.Value, CStr(r.Value)

　　Next r

　　.Range("A1").AutoFilter
　　If Not .AutoFilterMode Then .Range("A1").AutoFilter

　　For i = 1 To myList.Count

　　　Set wb = Workbooks.Add(xlWBATWorksheet)
　　　.Range("A1").AutoFilter field:=3, Criteria1:=myList(i)　　 '<<< ※０
　　　.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
　　　　　　　　　 Destination:=wb.Worksheets(1).Range("A1")

　　　wb.Worksheets(1).Cells(1, 3).Interior.Color = rgbGreen　　'<<< ※２

　　　wb.SaveAs Filename:=fPath & myList(i) & ".xlsx"　　　 '<<< ※３
　　　wb.Close　　　　　　　　　　　　　　　　　　　　　　　'<<< ※４

　　Next i

　　.Range("A1").AutoFilter

　End With

　Set myList = Nothing

End Sub