色々なものを見ながら作っている初心者です。

質問

色々なものを見ながら作っている初心者です。
よろしくお願いします。

VBAでのエラー対処について
下記のマクロを実行すると、実行時
「Selection.Resize(, Selection.Columns.Count - 2).Select」のところで
セルがブランクだった時にエラーが出てします。
対処の方法を教えていただけませんでしょうか？
よろしくお願いします。

Sheets("sheetB1").Select
Range("A7:C161").Select
Application.CutCopyMode = False
Selection.ClearContents

Sheets("sheetA").Select
Range("D12").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Resize(, Selection.Columns.Count - 2).Select
Selection.Offset(0, 1).Select

Selection.Copy
Sheets("sheetB1").Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("sheetA").Select
Range("E12").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("B1").Select
Range("C7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("sheetB2").Select
Range("A7:C161").Select
Application.CutCopyMode = False
Selection.ClearContents

Sheets("sheetA").Select
Range("J12").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Resize(, Selection.Columns.Count - 2).Select
Selection.Offset(0, 1).Select

Selection.Copy
Sheets("sheetB2").Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("sheetA").Select
Range("K12").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("steetB2").Select
Range("C7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=Fals

回答No.4

n-jun

＃３です。

全体の作業（終了条件など）がわからないのですが。

基になるシートが１つあって、複数のシートにデータを転記する。
基になるシートのセルに値がなくなったら終了？
その回数より転記先のシート数が少ないと言う事がない？

あと基になるシートのどの範囲を転記していくのか？

などが見えてこないのです。

回答No.3

n-jun

＃１＆２です。

極端な話ですと。

Ｄ１２について言えば

Sheets("sheetA").Select
Range("D12").Select

If ActiveCell.Value <> "" Then 'Selectしたセルの値が空白でない場合、下記コードを実行

Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Resize(, Selection.Columns.Count - 2).Select
Selection.Offset(0, 1).Select

Selection.Copy
Sheets("sheetB1").Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If '　Ifの相棒

でも対応出来ますが、全てに同じ事を書いていってもコードが長くなります。
よって規則性がわかると便利なんですけど。

お礼

ご連絡遅くなりましてすみません

ありがとうございます。
かなり助かりました。

規則性としては、

シートA上の、6列ごとに並んでいる表から選択して
シート(1)、(2)、(3)・・・・・・・のA4箇所に「値の貼り付け」で貼り付けていく
流れになります。

回答No.2

n-jun

＃１です。

規則性がわからないのですが。

まず
・シートＡの＜Ｄ１２～Ｄ最後＞をシートＢ１の＜Ａ７＞
・シートＡの＜Ｅ１２～Ｅ最後＞をシートＢ１の＜Ｃ７＞
と言う事ですか？

コピー元の範囲の選択条件と、コピー先の指定条件を提示された方が宜しいかと思います。

回答No.1

n-jun

例えば、

＞Range("D12").Select
＞Range(Selection, Selection.End(xlDown)).Select
＞Range(Selection, Selection.End(xlToLeft)).Select
＞Selection.Resize(, Selection.Columns.Count - 2).Select
＞Selection.Offset(0, 1).Select

１）Ｄ１２とＤ列の最終セル（仮にＤ２０）までの同行（１２～２０行）と、
２）Ｂ列とＣ列が交差する範囲（Ｂ１２～Ｃ２０）を取得したいとするなら、

Intersect(Range("D12", Range("D12").End(xlDown)).EntireRow, Range("B1:C1").EntireColumn).Select

で出来ます。

Range("D12", Range("D12").End(xlDown)).EntireRow
が１）の方。

Range("B1:C1").EntireColumn
が２）の方。

Intersect(
で双方が交差する範囲を取得します。

質問のブランクだった場合なら、事前にデータがあるかどうかを判断すると良いですが、
コードがどのような場合に使われようとしているのかちょっと不明です。

どこがブランクだった場合にどうしたい（どこを飛ばしたい）のとか。

お礼

n-jun様　早速ありがとうございます。
その通りでございます。
大変助かりました。

因みに、D12以下に位置するセルを他のシートにコピーする作業なのですが
それを列を変えて繰り返し違うシートに貼り付けていきたいのですが
後の列がブランクの時もあるので
無くなった時点で、エラー表示ではなく、終了という形にしたいです。
どのようなコマンドが必要なのでしょうか？

どうか知恵を御貸しください、よろしくお願いします。

補足

度々すみません、上の追加質問で

極端に言うと、D12のセルがブランクだったら終了という
事で大丈夫ですので、その場合に
何か良い方法がございますでしょうか？
お知恵を御貸しください。