Excek VBA 上へ詰めてコピー

質問

VBAの勉強を始めたのですが、単純コピーはわかるようになったものの、空行の上詰めしながらのコピーでつまづいているので教えてください。
またセル範囲について、RangeとCellsの使い分けでもつまづいています。

画像の"Sheet1"のようなデータがあります。データの始まりはセル"A1"から始まっていますが、末尾（最終行）はデータのより様々で、最終行が決まっていません（n行）。

このデータを任意のシート（例では"Sheet2"）の左上からコピーしたいのですが、その際に元の"Sheet1"のA列にエラー行が入ることがあります。エラー行は次の2種類です。

1. "error"など特定の文字（数字ではないもの）が入っている行
2. 空行（A列だけで判断）

これらのデータ行は、行そのものをSheet2にはコピーせず、上へ詰めて正常行をペーストしていきたいのです。

Dim i As Integer
For i の書き方
WorksheetsとCells（またはRange)
エラー行のスキップの仕方
などがわかりません。

元（Sheet1）のデータは概ね体裁が決まっており、データの例外（エラー）は上の1. 2以外は考えずに、シンプルな書き方を望んでいますが、どのように記載したらよいでしょうか。

回答No.1

keithin · ベストアンサー

１行目は数字じゃないけどコピーしたいとかの例外もあるのはまぁ良しとして。
要するに「Ａ列が数字（の生データを仮定）である」を拾ってコピーする、だけの事です。方策は山ほどあります。

sub macro1()
　worksheets("Sheet1").select
　rows(1).copy destination:=worksheets("Sheet2").range("A1")
　on error resume next
　range("A:A").specialcells(xlcelltypeconstants, xlnumbers).entirerow.copy _
　　destination:=worksheets("Sheet2").range("A2")
end sub

どーしても１行ずつ舐め回したいなら
sub macro2()
　dim h as range

　worksheets("Sheet1").select
　rows(1).copy worksheets("Sheet2").range("A1")

　for each h in range("A2:A" & range("A65536").end(xlup).row)
　　if h <> "" and isnumeric(h) then
　　　h.entirerow.copy destination:=worksheets("Sheet2").range("A65536").end(xlup).offset(1)
　　end if
　next
end sub

同じことを行番号で行うなら
sub macro2r()
　dim r as long

　worksheets("Sheet1").select
　rows(1).copy worksheets("Sheet2").range("A1")

　for r = 2 to range("A65536").end(xlup).row
　　if cells(r, "A") <> "" and isnumeric(range("A" & r)) then
　　　rows(r).copy destination:=worksheets("Sheet2").range("A65536").end(xlup).offset(1)
　　end if
　next
end sub

補足

ありがとうございます。

１行ずつ舐めるやり方を今後学ぶ必要がありそうです。
まずは教えていただいた記述を週末1つづつ勉強してみます。

回答No.4

keithin

＞１行ずつ舐めるやり方を今後学ぶ必要がありそう

どうしてそんな思い込みをしたのか、詳しい状況を添えて別途のご相談として投稿してみて下さい。

お礼

データは全体を操作するのと、列ごとに操作、提供データの行例（挿入場所も）を入れ替える、第三者からの提供データななどがある、などがあるのがわかっているので、いろいろ覚えていこうと思っています。

回答No.3

mt2008

ANo.1です。

> A～C列の各行はたぶん数千から万に達するデータがあるので（n行）、行数が確定していない場合のVBAの練習を現在しているのでした。

提示したコードはあくまでサンプルです。
ご自身の環境に合わせて修正してください。
ちなみに行数が不定なら
Range("A1:C13").の部分を、Range("A:C")にするだけです。

「複数シートに展開」ってのは条件も何も書かれていないので回答は控えさせていただきます。

回答No.2

mt2008

Excelは文字は数値より大きいと判断しますのでそれを利用してフィルターオプションで抽出しましょう。
添付の図の例では検索条件にE1：E2セルを使っています。
E1に検索条件の項目名「コード」。E2に不等号+コードの最大値より大きい数値、今回は「<999999」と入れました。
後は、以下のコードで2番目のシートに検索条件に合致した行だけ抽出されます。

Sub Sample()
　　Range("A1:C13").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( "E1:E2"), CopyToRange:=Worksheets(2).Range("A1"), Unique:=False
End Sub

お礼

ありがとうございます。
A～C列の各行はたぶん数千から万に達するデータがあるので（n行）、行数が確定していない場合のVBAの練習を現在しているのでした。

この質問は今後複数シートに展開されますので、今後ともよろしくお願いします。