[[20210905010224]]　『右側に数値があるところまでオートフィルをし、全』（ゆりこ）　ページの最後に飛ぶ

『右側に数値があるところまでオートフィルをし、全シートに同様の処理を行うVBA』（ゆりこ）

こんばんは。最近マクロを勉強しはじめた初心者です。

当方の質問を閲覧頂きまして、ありがとうございます。
もしお時間よろしければ、お答えいただけますと大変有難いです。

A列のみに以下のようなデータが並んでいます。

・シート１

サンプル1
4.515867375
3.919668043
4.912693257
4.545196094
3.800944986
4.458398916
5.182131131
4.94958445
4.7444993
5.997811319
5.269615454
4.926178124
6.722867979
3.35416738
（続く）

・シート2

サンプル2
5.142350574
3.962744914
6.407581315
6.434136402
6.241121118
6.306461195
9.891465232
3.672777731
3.156543568
5.847467695
7.708412884
6.245711914
（続く）

というような感じで各シートに別のサンプルのデータがズラーと入っており、
A列左に新しい列を挿入し、「番号」と書いてオートフィルをしてB列に数が入っている位置までオートフィルというのを各シートやっていきたいと思います。

番号サンプル1
1 4.515867375
2 3.919668043
3 4.912693257
4 4.545196094
5 3.800944986
6 4.458398916
7 5.182131131
8 4.94958445
9 4.7444993
10 5.997811319
11 5.269615454
12 4.926178124
13 6.722867979
14 3.35416738
15 （続く）

そこで、以下のようにコードを書いてみた（というか、マクロの記録をコピペしたりしていじった汚いコードでして、失礼いたします。）のですが、これだとレンジはB列に数字の有無に関わらずA列に50行まで数字が入ることになります。

Sub すべてのシートに同じ処理を実行する()

    Dim シートNo As Long
    For Each シート In Worksheets

        シート.Select
Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "番号"
    ActiveCell.Characters(1, 0).PhoneticCharacters = "バンゴウ"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A2").Select
     Selection.AutoFill Destination:=Range("A2:A50"), Type:=xlFillSeries
    Range("A2:A50").Select
    Next

End Sub

B列に数値があるセルまでA列を自動でオートフィルするように全てのシートに動作してもらうにはどうしたらいいでしょうか？
ネットで色々と検索してやってみたものの、エラーになってしまいます。
知恵をお貸頂けましたら、大変助かります。

ご覧いただきまして、ありがとうございました。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

 Sub test()

    Dim ws As Worksheet
    Dim rng As Range

    For Each ws In Worksheets
        With ws.Range("A1").CurrentRegion.Resize(, 1)
            .Insert Shift:=xlToRight
            If .Rows.Count > 1 Then
                Set rng = Intersect(.Cells, .Offset(1)).Offset(, -1)
            Else
                Set rng = .Cells.Offset(1, -1)
            End If
        End With
        ws.Range("A1").Value = "番号"
        With rng.Cells(1, 1)
            Select Case rng.Rows.Count
                Case 1
                    If ws.Range("A1").CurrentRegion.Rows.Count > 1 Then .Value = 1
                Case Is > 1
                    .Value = 1
                    .AutoFill Destination:=rng, Type:=xlFillSeries
            End Select
        End With
    Next

 End Sub
 一部訂正しました。 07:18
（xxx） 2021/09/05(日) 06:16

xxx様

ご回答ありがとうございます！
やってみたところ、上手くいきました！
大変勉強になりました。

お忙しいところ、お時間を割いて下さり、感謝いたします。
ありがとうございました。
（ゆりこ） 2021/09/05(日) 08:47

コメント返信：

[ 一覧(最新更新順) ]

[[20210905010224]] 『右側に数値があるところまでオートフィルをし、全』（ゆりこ） ページの最後に飛ぶ

[[20210905010224]]　『右側に数値があるところまでオートフィルをし、全』（ゆりこ）　ページの最後に飛ぶ