[[20150323131524]]　『複数あるシートの各最終行にペースト』（北国）　ページの最後に飛ぶ

『複数あるシートの各最終行にペースト』（北国）

シートが複数ありシート名に○○番とついているシートのみ
各シートのG2:J2のセルの値をコピーし、各々のＢ列の最終行に貼り付けしたいのです。
データが張られる場合は、Ｂ，Ｄ，Ｅ，Ｆと4つのデータが張られるようになります。

これをＶＢＡで作成しようと思っているのですが、素人でなかなかうまくいきません。
ご教授お願いします。
自分なりに考えて作成したが之こちらです。

Sub 値段貼り付け()

  Const FIND_STR = "番"  '探す文字列

  Dim find_flg As Boolean
  Dim sh As Object

  find_flg = False

  For Each sh In Sheets
    If sh.Name Like "*" & FIND_STR & "*" Then

      '見つかった1枚目のシートの場合
      If find_flg = False Then
        '元々選択されていたシートの選択を解除
        sh.Select Replace:=True
        find_flg = True
      '見つかった2枚目以降のシートの場合
      Else
        '選択済みシートの選択を解除しない
        sh.Select Replace:=False
        ' 値段コピー'
    Range("G2:J2").Select
    Selection.Copy

    '最終行を取得'
    Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 2).PasteSpecial Paste:=xlPasteValues

    End If
  End If
  Next sh
End Sub

こうすると最初の○○番シートの最終行だけ成功し、ほかのシートは最初の○○番シートと同じ行に入力してしまいます。シートによってデータが違うので最終行番号もシートごとに変わってきます。

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

 セルの参照をきちんとシートを含めて指定していないからです。

 例えば、
    Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 2).PasteSpecial Paste:=xlPasteValues
 は
    sh.Cells(sh.Cells(Rows.Count, 1).End(xlUp).Row + 1, 2).PasteSpecial Paste:=xlPasteValues
 のように。

 別案の一例です。

 Sub 値段貼り付け()
    Const FIND_STR = "番"  '探す文字列

    Dim ws As Worksheet
    For Each ws In Worksheets
        If InStr(ws.Name, FIND_STR) Then
            ws.Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(1, 4).Value = ws.Range("G2:J2").Value
        End If
    Next
 End Sub
（Mook） 2015/03/23(月) 13:41

Mookさん
ありがとうございます。
しかも短くしたものまで作成していただいてすごく勉強になりました、
長いものが省略されて短くなるというこの魅力にはまりそうです。

（北国） 2015/03/23(月) 13:50

コメント返信：

[ 一覧(最新更新順) ]

[[20150323131524]] 『複数あるシートの各最終行にペースト』（北国） ページの最後に飛ぶ

[[20150323131524]]　『複数あるシートの各最終行にペースト』（北国）　ページの最後に飛ぶ