[[20200522142042]]　『行を指定して自動分割』（みさ）　ページの最後に飛ぶ

『行を指定して自動分割』（みさ）

 エクセル（EXCEL)VBAの質問です。数千行にわたって入力されているデータがありますが、これをこちらが指定した行づつに分割して、別々の新規SHEETへコピーしていきたいのですが、これを実現するVBAを教えていただけ ないでしょうか？

 行の指定は、決まっています。
 20行　　100行　　150行　　200行　　250行　　300行
 といった感じです。

 毎回、シートのコピーを不必要な行を削除していますが、大変時間と労力がかかります。
 ご教示いただけたら幸いです。

＜使用 Excel：Excel2016、使用 OS：Windows8 ＞

 ＞ 行の指定は、決まっています。

 と言っても、数千行との整合性はどうなっていますか？
 合計がピッタリ合うとも思えないのですが。

 新規に作ったシートの名前はどうするんですか？

（半平太） 2020/05/22(金) 15:49

 >数千行にわたって入力されているデータがありますが

 シート名をSheets("Sheet1") としています。

 Sub Test()
    Dim i As Long, s As Long
    Dim sh As Worksheet, LastRow As Long

    With Sheets("Sheet1")
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        LastRow = Application.Ceiling(LastRow, 50)
        For i = 19 To LastRow
            If i = 20 Then
                With Worksheets
                    .Add(after:=.Item(.Count)).Name = "1-20"
                End With
                .Range(.Cells(1, 1), .Cells(i, "A")).Copy Range("A1")
                s = i + 1
            ElseIf i Mod 50 = 0 Then
                With Worksheets
                    .Add(after:=.Item(.Count)).Name = s & "-" & i
                End With
                .Range(.Cells(s, "A"), .Cells(i, "A")).Copy Range("A1")
                s = i + 1
            End If
        Next
        .Activate
    End With
 End Sub

（ピンク） 2020/05/22(金) 16:08

 ↑最後、端数が残るので修正しました。

（ピンク） 2020/05/22(金) 16:19

 回答ありがとうございました。
 もう1点追加で質問させてください。

 行数ですが、失礼いたしました、質問用にサンプルデータとしてしまいましたが、
 行数、1行目から50行を、シート1
 行数、51行目から120行目を、シート2
 行数、121行目～230行目までを、シート3

 にしたい場合、どのようにコードを書き換えますか？
 よろしくお願いいたします。

（みさ） 2020/05/22(金) 18:54

 >行数、1行目から50行を、シート1
 >行数、51行目から120行目を、シート2
 >行数、121行目～230行目までを、シート3
 >にしたい場合、どのようにコードを書き換えますか

 Sub Test()
    Dim i As Long

    With Sheets("Sheet1")
        i = i + 1
        With Worksheets
            .Add(after:=.Item(.Count)).Name = "シート" & i
        End With
        .Range("A1:A50").Copy Range("A1")

        i = i + 1
        With Worksheets
            .Add(after:=.Item(.Count)).Name = "シート" & i
        End With
        .Range("A51:A120").Copy Range("A1")

        i = i + 1
        With Worksheets
            .Add(after:=.Item(.Count)).Name = "シート" & i
        End With
        .Range("A121:A230").Copy Range("A1")
    End With
 End Sub

（ピンク） 2020/05/22(金) 19:34

 Sub Test2()
    Dim i As Long, j As Long, s As Long

    With Sheets("Sheet1")
        s = 1
        For i = 1 To 3
            j = Choose(i, 50, 120, 230)
            With Worksheets
                .Add(after:=.Item(.Count)).Name = "シート" & i
            End With
            .Range(.Cells(s, "A"), .Cells(j, "A")).Copy Range("A1")
            s = j + 1
        Next
    End With
 End Sub

（ピンク） 2020/05/22(金) 20:00

 ピンクさんありがとうございました。
 誠に申し訳ありませんが、コピーをする際、列の幅、行の幅、印刷レイアウト等、
 元シートと同じようにコピーするにはどうしたらいいですか？

 何度もご質問し申し訳ありあせん。
（みさ） 2020/05/22(金) 21:04

 >印刷レイアウト等、元シートと同じようにコピーするにはどうしたらいいですか？

 元の状態が此方からは見えない

 わかる範囲で

 Sub Test3()
    Dim i As Long, j As Long, s As Long

    With Sheets("Sheet1")
        s = 1
        For i = 1 To 3
            j = Choose(i, 50, 120, 230)
            With Worksheets
                .Add(after:=.Item(.Count)).Name = "シート" & i
            End With
            .Range(.Cells(s, "A"), .Cells(j, "A")).Copy Range("A1")
            Columns(1).ColumnWidth = .Columns(1).ColumnWidth
            Range("A1").Resize(j + 1 - s).RowHeight = .Cells(s, "A").RowHeight
            ActiveSheet.PageSetup.PrintArea = Range("A1").Resize(j + 1 - s).Address
            s = j + 1
        Next
        .Activate
    End With
 End Sub

（ピンク） 2020/05/22(金) 22:03

コメント返信：

[ 一覧(最新更新順) ]

[[20200522142042]] 『行を指定して自動分割』（みさ） ページの最後に飛ぶ

[[20200522142042]]　『行を指定して自動分割』（みさ）　ページの最後に飛ぶ