|
現状 下のコードを書いて、特定の値が含まれる行を抽出して別のシートに抽出したのはいいのですが、空白行が多く詰めようと思い色々なサイト等で書かれている空白行削除のマクロをつかってみましたが。空白行がまったく削除されませんでした。
やりたい事は特定の値を含む行の抽出して別シートに揃える事なので
このコードから空白行を仕分けられるやり方、若しくは根本的に別のやり方がありましたら教えてください。
2003を使用しています。
自分で書いたもの、
Sub findtheword()
Dim CurPos As Range
Dim i As Integer
i = 2 '行2段目から開始
Application.ScreenUpdating = False
Do
With Worksheets("sheet1")
Set CurPos = Cells(i, 13) '特定値を含む列にあわせる
If CurPos = "" Then '値が空白だった場合 別シートに行ごとコピペ
Range(Cells(i, 1), Cells(i, 200)).Copy Destination:=Worksheets("sheet2").Cells(i, 1)
Set CurPos = CurPos.Offset(1, 0)
ElseIf CurPos = "特定値" Then '特定値だった場合 別シートに行ごとコピペ
Range(Cells(i, 1), Cells(i, 200)).Copy Destination:=Worksheets("sheet3").Cells(i, 1)
Set CurPos = CurPos.Offset(1, 0)
Else '値が上に当てはまらない場合下セルに移行する。
Set CurPos = CurPos.Offset(1, 0)
End If
End With
i = i + 1
Loop Until i = 26000
End Sub
|
|