| 
    
     |  | >コードが変わる毎に別シートにデータを移動する方法とはどう記述すればいいのですか? 遅くなりました。
 以下のコードで動作するはずです。
 
 Sub test()
 Dim seru As Range 'データを比較されるセル
 Dim i As Long '現在のデータ行
 Dim presheet As String
 
 i = 2 'データの開始行。
 
 Application.ScreenUpdating = False
 
 '以下はA列がコードが入っている列とした場合です。
 Set seru = Range("A2")
 ActiveSheet.PageSetup.LeftHeader = Range("B2").Value
 Do Until i = Range("A65536").End(xlUp).Row
 If Range("A" & i).Value <> seru.Value Then
 n = Range("A65536").End(xlUp).Row
 presheet = ActiveSheet.Name
 Range("1:1,A" & i & ":A" & n).EntireRow.Copy
 Sheets.Add
 ActiveSheet.Paste
 Sheets(presheet).Range("A" & i, "A" & n).EntireRow.Delete
 ActiveSheet.PageSetup.LeftHeader = Range("B2").Value
 Set seru = Range("A2")
 i = 3
 Else
 i = i + 1
 End If
 Loop
 Application.ScreenUpdating = True
 End Sub
 
 |  |