| |
▼マナ さん：
>▼inoue さん：
>
>>しかし、取得できた領域はその1ファイルのみでした。
>>これを任意のフォルダ内にあるすべてのファイルに対して行うためには
>>どのようにすればよいでしょうか。
>
>現在のコードで、値を転記している箇所、
>
>>rIdx = rIdx + 1
>>
>>Cells(rIdx, 1).Value = fName
>>Me.Cells(rIdx, 2).Value = ActiveSheet.Range("A1").Value
>>Me.Cells(rIdx, 3).Value = ActiveSheet.Range("B1").Value
>>Me.Cells(rIdx, 4).Value = ActiveSheet.Range("C1").Value
>>Me.Cells(rIdx, 5).Value = ActiveSheet.Range("D1").Value
>>Me.Cells(rIdx, 6).Value = ActiveSheet.Range("E1").Value
>>Me.Cells(rIdx, 7).Value = ActiveSheet.Range("F1").Value
>
>ここに、組み込むのです。
>考えてみてください。
>転記先のセルは、End（xlup).Offset(1)で求めると良いと思います。
マナさん
度重なるご指導ありがとうございます！！
おっしゃる通りにしましたら望みのことができました。
日曜日にこのような無知なものにお付き合いいただき
誠にありがとうございました。
これを機にvbaのコードにも理解を深めていきたく思います。
下記に成功したコードを記載させていただきます。
Sub test()
Application.ScreenUpdating = False
Const myPath As String = "C:Users\ユーザ名\Desktop\フォルダ名\"
Dim fName As Strimg
fName = Dir (myPath & "*.xls")
Do Until fName = ""
Workbooks.Open Filename:=myPath & fName
Dim ws As Worksheet
Dim r As Range
Dim myStr As String
myStr = "目印"
Set ws = ActiveSheet
Set r = ws.Cells.Find(What:=myStr, LookIn:=xlValues, LookAt:=xlWhole)
Set r = r.CurrentRegion
Set r = Intersect(r, r.Offset(2))
r.Copy
Worksheets.Add
Range("A65536").End(xlUp).Offset(1).PasteSpecial xlPasteValues
Windows(fName).Close
fName = Dir
Loop
Applicaion.ScreenUpdating = True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
