| |
こんにちは。
Sub ika()
Dim CelA As Range, CelB As Range
Dim SaveAdA As String, SaveAdB As String
Dim STB() As String, CN As Long
Set CelA = Columns("A").Find("80", After:=Range("A" & Rows.Count), _
LookAt:=xlWhole, MatchCase:=True)
Set CelB = Columns("A").Find("B5", After:=Range("A" & Rows.Count), _
LookAt:=xlWhole, MatchCase:=True)
If Not CelA Is Nothing And Not CelB Is Nothing Then
SaveAdA = CelA.Address
SaveAdB = CelB.Address
Do
CN = CN + 1
ReDim Preserve STB(1 To 2, 1 To CN)
STB(1, CN) = CelA.Address
STB(2, CN) = CelB.Address
Set CelA = Columns("A").Find("80", After:=CelA, _
LookAt:=xlWhole, MatchCase:=True)
Set CelB = Columns("A").Find("B5", After:=CelB, _
LookAt:=xlWhole, MatchCase:=True)
Loop Until SaveAdA = CelA.Address Or SaveAdB = CelB.Address
For i = 2 To UBound(STB, 2)
RED = Cells(Rows.Count, "D").End(xlUp).Row + 1
Range(STB(1, i), STB(2, i)).Offset(, 1).Copy Destination:=Range("D" & RED)
Next
End If
|
|
- 03/4/23(水) 22:16 -
