[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『別のシートにコピペ、指定したものだけ』(たなか)
いつもお世話になっております。
sheet1のA列に「1」が入っている行だけ、sheet2にコピペするのですが、
下図のように貼り付けたいです。
[sheet1]
A列 B列 C列 D列
1行 1 コードあ 品名あ 数量あ
2行 コードい 品名い 数量い
3行 1 コードう 品名う 数量う
4行 1 コードえ 品名え 数量え
5行 コードお 品名お 数量お
[sheet2]
A列 B列 C列 D列
1行 コードあ コードう コードえ
2行 品名あ 品名う 品名え
3行 数量あ 数量う 数量え
で、コードを並べてみたのですが、「オブジェクトが必要です」と
エラーが出ます。
どうすれば実行できるでしょうか。
よろしくお願いします。
Sub コピペ()
For i = 1 To 10
If Worksheets("sheet1").Cells(i, 1) = "1" Then
With Worksheets("sheet2").Cells(1, 1).End(xlToRight).Column .Offset(0, 1) = Worksheets("sheet1").Cells(i, 2) .Offset(1, 1) = Worksheets("sheet1").Cells(i, 3) .Offset(2, 1) = Worksheets("sheet1").Cells(i, 4) End With
End If
Next i
End Sub
< 使用 Excel:Excel2019、使用 OS:Windows10 >
If Sheets("Sheet1").Cells(i, 1).Value = 1 Then Colct = Colct + 1 Sheets("Sheet2").Cells(1, Colct).Resize(3, 1).Value = WorksheetFunction.Transpose(Sheets("Sheet1").Cells(i, 2).Resize(, 3).Value) End If i = i + 1 Loop Until Sheets("Sheet1").Cells(i, 2).Value = "" (mihon) 2021/09/14(火) 14:35
■2
よって、単純に直すなら「.Column」を取ればよいが
Sub コピペ修正() Dim i As Long
For i = 1 To 10 If Worksheets("sheet1").Cells(i, 1) = "1" Then With Worksheets("sheet2").Cells(1, 1).End(xlToRight) .Offset(0, 1) = Worksheets("sheet1").Cells(i, 2) .Offset(1, 1) = Worksheets("sheet1").Cells(i, 3) .Offset(2, 1) = Worksheets("sheet1").Cells(i, 4) End With End If Next i End Sub
場合によっては↓が問題を引き起こすことになる
Worksheets("sheet2").Cells(1, 1).End(xlToRight)
先に「sheet2のA1セルから右に見ていき」と述べたが、実際にはsheet2の1行目が空っぽの場合や、A1セルのみにデータが入っている場合残念なことになる。(実験してみればわかるはず)
■3
よって、普通は、【最大列から左】に見ていき見つかったセルという指定をするアプローチがよく採られます。
Sub コピペ修正_改() Dim i As Long
For i = 1 To 10 If Worksheets("sheet1").Cells(i, 1) = "1" Then With Worksheets("sheet2").Cells(1, Columns.Count).End(xlToLeft) .Offset(0, 1) = Worksheets("sheet1").Cells(i, 2) .Offset(1, 1) = Worksheets("sheet1").Cells(i, 3) .Offset(2, 1) = Worksheets("sheet1").Cells(i, 4) End With End If Next i End Sub
これで大体の問題が解決するが、sheet2がまっさらだった場合にはB列から始まってしまうという問題が残ります。
■4
↑の問題は、1列目(というか、A1セル)にデータがあるかどうかで判定するという手が使えます。
さらに、1セルずつ転記をせずともプロシージャ名どおり、【コピペ】でも対応。
Sub 研究用() Dim i As Long Dim 出力セル As Range
Stop 'ブレークポイントの代わり
Set 出力セル = Worksheets("sheet2").Cells(1, Columns.Count).End(xlToLeft) If 出力セル.Value <> "" Then Set 出力セル = 出力セル.Offset(0, 1)
With Worksheets("sheet1") For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row If .Cells(i, 1) = "1" Then .Cells(i, "B").Resize(1, 3).Copy 出力セル.PasteSpecial Transpose:=True Set 出力セル = 出力セル.Offset(0, 1) End If Next i End With
End Sub
■5
最後に、ネット検索で見かけたコードや質問掲示板で回答のあったコードは闇雲に実行するのではなく、きちんとステップ実行しつつ、判らない部分はしらべたり聞いたりしてちゃんと理解することをお勧めします。
(でないと、今回のようなミスに自分で気付けなくなってしまうので)
(もこな2) 2021/09/14(火) 15:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.