該当するデータのみを右上のセルへ張付るには

質問

いつもお世話になっております。
また先に進めずに5日間悪戦苦闘しております。

とあるデータをExcelにエクスポートをすると、Ａ列に全てデータが入っている状態のものが出来上がります。
一覧表として見やすい形にもって行きたく、タイトルやデータの作成日、項目等は各セルへ移動させました。
4行目・6行目に表示されているものが、3行目の項目で言うところの「番号」に該当し、5行目・7行目に表示されているものが、空欄を区切りとして左から「都道府県コード」・「市町村コード」・「番地」に該当します。
4行目と5行目がひとセットのデータ、6行目・7行目がひとセットのデータになります。（このセットデータが100件以上下に連なっています）
ずれている奇数行のデータをまずＢ列へ移動し、そこからＣ・Ｄ行へ移したいと考えたのですが、どうしてもコードがうまく走ってくれませんでした。
以下が表です。
　　　　　Ａ　　　　　　　Ｂ　　　　　　　Ｃ　　　　Ｄ　　
１　タイトル
２　データの作成日
３　　　番号　　　　都道府県コード　市町村コード　番地　
４　【100001】
５　00001　0003　●●●530-8-7
６　【103205】
７　03479　7094　△○■1-2-3

こちらが作成したコードです。

Worksheets("Sheet1").select
Range("A5").Select
Selection.AutoFilter Field:=1,Criterial:="0*",Operator:=xlAnd
Selection.SpecialCells(xlCellType Visible).Select
Application.CutCopyMode = False
Selection.Copy
Selection.AutoFilter
Selection.Offset(-1,1).Select
ActiveSheets.Paste
End Sub

仕様はExcel2002になります。
都道府県コードは必ず0から始まるので、0から始まるデータを右上のセルへ移動するという指示をだしているつもりです。
以上、宜しくお願い致します。

回答No.2

n-jun · ベストアンサー

４行目以降が提示された状態で最終行まで続いているとします。
Ｂ～Ｄ列のセルの書式設定を文字列にしてから実行。
文字の区切りは全角のスペースである事が条件。

Sub try()
Dim i As Long

For i = Range("A" & Rows.Count).End(xlUp).Row To 5 Step -2
Range("B" & i - 1).Resize(, 3).Value = Split(Range("A" & i).Value, "　")
Rows(i).Delete
Next

End Sub

こんな感じとか？

お礼

回答ありがとうございました。
教えていただきましたコードを参考にさせていただいた結果動いてくれました。
ありがとうございました！
せっかくなので、動いた結果をのせておきます。

Worksheets("Sheet1").select
Dim i As Long
For i = Range("A" & Rows.Count).End(xlUp).Row To 5 Step -2
Range("B" & i - 1).Resize(, 1).Value = Split(Range("A" & i).Value, " ")
Next

Dim k As Long
Range("A5").Select
For k =Cells(Rows.Count,1).End(xlUp).Row To 2 Step -1
With Cell(k,1)
If.Value Like "0*" Then.IntireRow.Delete
End With
Next
End Sub

回答No.1

imogasi

インポート直後のA列の１５行ぐらいを質問にかき、完成形のシート各列データを別に下記に書き、それに説明や注意事項を添えるという形にしないと
質問の内容がわからないと思いませんか。