| |
題名あるようなマクロを調べて作成したのですがうまく機能しません
f = c.Row
の場所がよくないのかいろいろ試してみたのですが、わかりません。
ご指導いただければありがたいです。
Sub selectfoundsheets()
Dim las As Long
Dim sh2 As Worksheet
Dim a As String
Set sh2 = Worksheets("test")
a = ActiveCell.Value
las = 1
For Each s In Worksheets
vx = MsgBox(s.Name & "を検索しますか", vbYesNo)
If vx = vbYes Then
s.Select
Set c = s.Range("B:B").Find(what:=a)
If Not c Is Nothing Then
f = c.Row
Do
' f = c.Row
s.Range(s.Cells(f, 1), s.Cells(f, 7)).Copy
sh2.Cells(las, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
las = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
Set c = Cells.FindNext(c)
'f = c.Row
Loop While Not c Is Nothing And c.Row <> f
'f = c.Row
End If
End If
Next s
End Sub
|
|
JIRORO
- 11/11/3(木) 11:19 -
