|
こんばんわ。どうしてもうまくいかないので
どなたか、教えていただけないでしょうか?
★あるデータから抽出した4桁の番号が"A5"からした方向にあります。
(どのセルまであるかは、場合によって違います)
★そのデータの範囲を検索し、1*** のように、1から始まる4桁の番号が
あるセルをコピーして、"D5"にコピーしたいのです。
(4桁の番号は重複コードはありません)
Sub てすと()
Dim add As String
Dim rng As Range
Dim z As Long
Dim n As Long
n = 0
z = Range("A5").End(xlDown)
Set rng = Range("A5:L" & z).Find(What:="1*")
If rng Is Nothing Then
Exit Sub
Else
add = rng.Address
End If
Do Until rng Is Nothing
rng.Copy
Range("D5").Offset(n).PasteSpecial Paste:=xlPasteValues
n = n + 1
Set rng = Range("A5:A" & z).FindNext(rng)
If add = rng.Address Then
Exit Do
End If
Loop
End Sub
上記ですと、まず検索が1001のような場合だけではなく、2001のような
1が含まれるセルは全て抽出してしますのです。
次に、ループが終わらずに、何度も、同じセルをコピーして
どんどん下に貼っていくのです。
どなたか、ご指南よろしくお願いいたします。
|
|