どのコードを利用されているのかわかりませんので、3つ目のコードの例です。
B列の値で振り分け先のシートを決めます。
A列を無視して、B:C列を別シートのA:Bにコピーします。
'----列見出しをコピー&貼り付け
Worksheets("Sheet1").Range("B1:C1").Copy Worksheets(myKey).Range("A1")
と
'----データを転記する
Worksheets("Sheet1").Range("B" & i & ":C" & i).Copy _
Worksheets(myKey).Range("A" & myRow & ":C" & myRow)
の2つを B列に変更して、A列を無視しています。
Sub test1()
Dim i As Long
Dim lastRow As Long
Dim mySh As Worksheet
Dim myFlg As Boolean
Dim myRow As Long
Dim myKey As String
lastRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
'----振り分け先のシートが存在するか否かをチェック
For Each mySh In Worksheets
myFlg = False
myKey = Worksheets("Sheet1").Range("B" & i).Value
If mySh.Name = myKey Then
myFlg = True
mySh.Cells.Delete
Exit For
End If
Next mySh
'----振り分け先のシートがなかったらシートを追加する
If myFlg = False Then
ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = myKey
End If
'----列見出しをコピー&貼り付け
Worksheets("Sheet1").Range("B1:C1").Copy Worksheets(myKey).Range("A1")
Next i
'----データを転記する
For i = 2 To lastRow
myKey = Worksheets("Sheet1").Range("B" & i).Value
If myKey <> "" Then
myRow = Worksheets(myKey).Range("A" & Rows.Count).End(xlUp).Row + 1
Worksheets("Sheet1").Range("B" & i & ":C" & i).Copy _
Worksheets(myKey).Range("A" & myRow & ":C" & myRow)
End If
Next i
End Sub
|