[[20170218224523]]　『シート間コピー貼付け』（ちゃんぷる）　ページの最後に飛ぶ

『シート間コピー貼付け』（ちゃんぷる）

お世話になっております。

ActiveシートのB列セルとF列：AJ列までをコピーして
※B列は最初の行
※F列以降は、Step3　行目範囲

請求DataシートのB列～転記（B列2行目～追記）する

といったコードを作成しました。

ただ、転記元データコピーと転記先への追記について

ループがおかしいようで、２重ループ？されているようです。

アドバイスの程よろしくお願いします。

Sub シート間データ転記()

    '---Data範囲の特定------------------------------------------------
    Dim hi_top As Integer, hi_last As Integer 'ひ範囲
    Dim su_top As Integer, su_last As Integer 'す範囲
    Dim ko_top As Integer, ko_last As Integer 'コ範囲
    Dim col As Range    '検索列
    Set col = Range("AM:AM")

    hi_top = col.Find("hi1").Row + 1
    hi_last = col.Find("hi2").Row - 1

    su_top = col.Find("su1").Row + 1
    su_last = col.Find("su2").Row - 1

    ko_top = col.Find("ko1").Row + 1
    ko_last = col.Find("ko2").Row - 1

    '---転記処理------------------------------------------------
    Dim sh1 As Worksheet    '転記元Sheet
    Dim sh2 As Worksheet   '転記先Sheet
    Set sh1 = ActiveSheet
    Set sh2 = Worksheets("請求Data")
    Dim mn As String
    mn = sh2.Range("B65536").End(xlUp).Row

    Dim i As Long
    Dim j As Variant

    Dim myData1 As Variant
    Dim myData2 As Variant

    For i = hi_top To hi_last Step 3  '2行置き
       '転記元データ格納
       myData1 = sh1.Range("B" & i).Value
       myData2 = Range("F" & i + 2 & ":AJ" & i + 2).Value

       '転記先にデータ追記
       For j = 1 To mn
       sh2.Range("B" & mn).Value = myData1
       sh2.Range("C" & mn & ":AF" & mn).Value = myData2
       j = j + 1
       mn = mn + 1
       Next j

    Next i

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

1) 内側のjのループを削除
2) j=j+1も削除

でどうなりますか?

（マナ） 2017/02/18(土) 23:09

マナさん

おっしゃる通りにするとバッチリでした。

やっと次のステップに移れます。

もう少しいじってみたいと思います。
（ちゃんぷる） 2017/02/18(土) 23:19

コメント返信：

[ 一覧(最新更新順) ]

[[20170218224523]] 『シート間コピー貼付け』（ちゃんぷる） ページの最後に飛ぶ

[[20170218224523]]　『シート間コピー貼付け』（ちゃんぷる）　ページの最後に飛ぶ