行挿入+貼付けと空白行削除を同時に行うには？

行挿入+貼付けと空白行削除を同時に行うには？

VBA初心者です。
仕事でエクセルを使っていますが、


no　　工程1　工程2　工程3
1　　　A　　　B　　　C
2　　　B　　　_　　　A
3　　　C　　　A　　　_
4　　　_　　　C　　　A


という表を
no　　工程
1　　　A
　　　　B
　　　　C
2　　　B
　　　　A
3　　　C
　　　　A
4　　　C

というように並び替えたいのですが、
現在は各番号ごとに3行挿入して工程をコピー、行と列を入れ替えて貼付けをしています。
これだと
no　　工程
1　　　A
　　　　B
　　　　C
2　　　B　

　　　　A
3　　　C
　　　　A

4
　　　　C
　　　　A
のように空白行ができてしまいます。これをもう一度、マクロで消しているのですが、
データ量が多いため、行挿入と空白行を消す作業を同時に行わないとシート最大行数である
65536行を超えてしまう可能性があります。
同時にやるにはどのようにすればよいのでしょうか？
よろしくおねがいします。

No.1 回答者： myRange 回答日時： 2010/02/17 16:07

＞データ量が多いため、行挿入と空白行を消す作業を同時に行わないとシート最大行数である

65536行を超えてしまう可能性があります。

同じシートで処理するのではなくて、別シートにコピぺしてやれば
少なくとも空白行を挿入したりのコードは不要になるので
現在のコードをちょこっと修正するだけですむのでは？
　
以上です。

　

この回答への補足

おっしゃるとおりに現在はやっているのですが、
かなりの行をコピペするのがめんどくさいのと
ミスが怖いのでできるなら一発でやりたいなと思っています。
まあできなさそうならあきらめるしかないのですが。

補足日時：2010/02/17 16:19

No.2 ベストアンサー 回答者： chibita_papa 回答日時： 2010/02/24 16:22

参考にしてください。

配列に入れて一度に書き出します。
サンプルでは、F列G列へ

Sub test()
Dim varArray(1 To 65536, 1 To 2)
varArray(1, 1) = "no"
varArray(1, 2) = "工程"

Dim i As Long, r As Long, c As Long

i = 2
For r = 2 To Range("A65536").End(xlUp).Row
varArray(i, 1) = Cells(r, 1)
For c = 2 To 4
If Cells(r, c) <> "" Then
varArray(i, 2) = Cells(r, c)
i = i + 1
End If
Next c
Next r
Range("F1:G65536") = varArray
End Sub

この回答へのお礼

ありがとうございます！完璧です。
おかげでうまくいきましたm(_ _)m

お礼日時：2010/02/26 18:03