Excel マクロ オフセット 変数

Question

前提・実現したいこと

基礎的なExcelマクロでの質問です。
下記マクロで変数の定義が原因かオフセットがうまくいかず、
ループでのデータ貼り付けがうまくいきません。

実現したいこと
「d3」(例:10)になるまで「f3」を1ずつ足していき(例:10)になったら終了
その間「f3」の値の「B15:b16」をコピー、貼り付けし、次の下の行に改行し再度貼り付け

発生している問題・エラーメッセージ

Sub test1()

Dim a As Worksheet
Dim b As String

Set ws = Worksheets("sheet1")
b = (ws.Range("f3") - 1) * 2

Do Until ws.Range("f3") = ws.Range("d3")

ws.Range("B15:b16").Copy
Worksheets("マクロ用書き出し").Range("a9:a10").Offset(b).PasteSpecial Paste:=xlPasteValues
ws.Range("f3") = ws.Range("f3") + 1

Loop

End Sub

補足情報（FW/ツールのバージョンなど）

windows10,Excel(Office 365)

Answer 1

あなたのマクロをできるだけ生かすようにしました。
こういうことでしょうか。

Sub test1()

    Dim ws As Worksheet
    Dim b As Long

    Set ws = Worksheets("sheet1")
    b = (ws.Range("f3") - 1) * 2
    Do
        If ws.Range("f3") > ws.Range("d3") Then Exit Do
        ws.Range("B15:b16").Copy
        Worksheets("マクロ用書き出し").Range("a9:a10").Offset(b).PasteSpecial Paste:=xlPasteValues
        If ws.Range("f3") = ws.Range("d3") Then Exit Do
        ws.Range("f3") = ws.Range("f3") + 1
        b = b + 2
    Loop

End Sub

Comments

[stkaz]

回答ありがとうございます。
あなたのマクロが理想のマクロです！
ご教授ありがとうございました。
ベストアンサーとさせて頂きます。

Answer 2

こういうことかな？

Sub test001()
    Dim ws As Worksheet
    Dim b As Long
    
    Set ws = Worksheets("Sheet1")
    
    ws.Range("B15:B16").Copy
    Do
        Worksheets("マクロ用書き出し").Range("A9:A10").Offset(b).PasteSpecial Paste:=xlPasteValues
        b = b + 2
    Loop Until ws.Range("F3").Value + b > ws.Range("D3")
    Application.CutCopyMode = False
End Sub

ループしなくても貼り付け範囲を拡張したらいいかも？

Sub test002()
    Dim i As Long
    
    With Worksheets("Sheet1")
        i = .Range("D3").Value - .Range("F3").Value
        .Range("B15:B16").Copy Worksheets("マクロ用書き出し").Range("A9:A10").Resize(i * 2)
    End With
End Sub

※こんな感じかなぁというイメージです。
動作確認は行ってません。細かい計算など修正願います。

---

画像見ました。

僕ならこんな感じで書きます。（いろんな書き方があります）

Sub test003()
    Dim rngFrom As Range
    Dim rngTo As Range
    Dim c As Range
    Dim ixMin As Long
    Dim ixMax As Long
    Dim ix As Long
    
    With Worksheets("Sheet1").Range("C5").CurrentRegion
        Set rngFrom = Intersect(.Cells, .Offset(1), .Columns(2))
        ixMin = .Worksheet.Range("F3").Value
        ixMax = .Worksheet.Range("D3").Value
    End With
    Set rngFrom = Application.Range(rngFrom(ixMin), rngFrom(ixMax))
    Set rngTo = Worksheets("マクロ用書き出し").Range("A9")
    
    ix = 1
    For Each c In rngFrom
        c.Copy rngTo(ix, 1)
        ix = ix + 2
    Next
End Sub

Comments

[stkaz]

ご回答ありがとうございます。
今回のものでは試したところうまく作動が出来ず、
加工、修正してもうまく動作が行えませんでした。

他の方からいただいた回答で何とか、解決案を出せそうです。

今回回答頂いたものは他の作成時に参考にさせて頂きます。
ありがとうございました。

Answer 3

Dim a As Worksheet
Dim b As String
は
Dim ws As Worksheet
Dim b As Long
に定義しなおしてください。

なにをなさりたいのかがよくわかりません。
実行前のSheet1の内容と
実行後の期待する結果の「マクロ用書き出し」の内容を添付図のようにして提示してください。

Comments

[stkaz]

回答ありがとうございます。
理想とするマクロ結果を画像にて追記しました。
もしよろしければご教示願います。