Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2013)
複数の別シートのデータを一枚のシートに貼り付けたい
投稿日時: 18/05/29 17:27:06
投稿者: ジョンのおばちゃん

お忙しいところ恐縮ですが、また教えていただきたく投稿させていただきました。(VBA初心者です)
シートは13枚あります。1枚目は2〜13枚目までのデータを張り付けたいです。私が作ったSubでは13枚目のデータばかりが12個並んでしまいます。貼り付け位置の指定が間違っていると思いますが、どうすればよいかさっぱり思案に余っています。教えていただけたらとてもうれしいです。私がつくっているのはしたのものです。
 
Sub 貼り付け()
    Dim i As Long
    Dim 列 As Long
    i = Worksheets.Count
     
    For i = 2 To i
    For 列 = 1 To 48 Step 4
         
        Sheets(i).Activate
            Range("F2:H34").Copy
        Sheets("年間").Select
        
       ActiveSheet.Paste Destination:=Cells(3, 列)
          'Sheets(13)の同じデータが12個並んでいる
       Sheets("年間").Select
    Next 列
    Next i
End Sub
 
私が作りたい年間シートのイメージは下です、A:C列で1月分、D列空列、E:G列2月分。以下同じです。
 
   A   B   C     D   E   F   G       H・・・
1
2   2018 1    '18年1月      2018  2   ’18年2月
3   日  曜    祝日       日  曜日    祝日  
4   1  日     元旦       1  木
5   2  月            
6   3  火


31                    28  水
34  31  水
 
どうぞよろしくお願いいたします。

回答
投稿日時: 18/05/29 17:49:08
投稿者: sk

引用:
私が作ったSubでは13枚目のデータばかりが12個並んでしまいます。

引用:
For 列 = 1 To 48 Step 4

引用:
ActiveSheet.Paste Destination:=Cells(3, )

また 1 からやり直されているので。
 
---------------------------------------------------------
Sub 貼り付け()
 
    Dim i As Long
    Dim 列 As Long
     
    列 = 1
     
    For i = 2 To Worksheets.Count
        Worksheets(i).Range("F2:H34").Copy
        With Worksheets(1)
            .Paste Destination:=.Cells(3, 列)
        End With
        列 = 列 + 4
    Next i
     
    Worksheets(1).Activate
    Application.CutCopyMode = False
     
End Sub
---------------------------------------------------------

投稿日時: 18/05/29 19:22:34
投稿者: ジョンのおばちゃん

早速ありがとうございました。
見事に難問が解決できました。とてもうれしいです。
 
End With の後に「 列 = 列 + 4 」を使えるとは全く知りませんでした。とても勉強になりました。
 
じつは、「 列 = 列 + 4」これは先ほど思いついたのですが、これではSheets(2)のデータの貼り付けが D列からになるのでどうしたら良いか悩んでいました。
 
本当にありがとうございました。経験をたくさんすることが大切だと改めて感じています。今後ともどうぞよろしくお願いいたします。