| |
ご教授下さい。
ＶＢＡ初心者です。
色々とコードを組んでみたのですが、
解らなくなってしまいました。
---------------やりたい事------------------------------------------------------
D:\プリンタ\Ｐ情報*.xls
上記の対象フォルダの対象全エクセルファイルの「プリンタ」シートを
現在開いているエクセルファイルの「プリンタ全情報」シートに設定します。
ファイルは複数存在します。
＜設定条件＞
1.Ｐ情報*.xlsの B2セル + C2セルを「プリンタ全情報」A2セルに設定
2.Ｐ情報*.xlsの D4セルを「プリンタ全情報」B2セルに設定
3.Ｐ情報*.xlsの D5セルを「プリンタ全情報」C2セルに設定
4.Ｐ情報*.xlsの D6セルを「プリンタ全情報」E2セルに設定
【Ｐ情報A.xls】
[プリンタ]シート
A B C D E F
1 |ｺｰﾄﾞ1 ｺｰﾄﾞ2 記号 項目1 項目2 項目3
2 |A001 A11 C1 K11 K21 K31
3 |A002 A12 C2 K12 K22 K31
4 |A003 A13 C3 K13 K23 K33
5 |A004 A14 C4 K14 K24 K34
6 |A005 A15 C5 K15 K25 K35
【Ｐ情報BBB.xls】
[プリンタ]シート
A B C D E F
1 |ｺｰﾄﾞ1 ｺｰﾄﾞ2 記号 項目1 項目2 項目3
2 |B001 B11 F1 Z11 Z21 Z31
3 |B002 B12 F2 Z12 Z22 Z31
4 |B003 B13 F3 Z13 Z23 Z33
5 |B004 B14 F4 Z14 Z24 Z34
6 |B005 B15 F5 Z15 Z25 Z35
-----------------------------------------------
【現在開いているファイル.xls】
[プリンタ全情報]シート
A B C D
1 |項目1 項目2 項目3 項目3
2 |A11C1 K13 K14 K15 ←【Ｐ情報A.xls】の情報
3 |B11F1 Z13 Z14 Z15 ←【Ｐ情報BBB.xls】の情報
---------------コード----------------------------------------------------------
Sub test()
Dim myFile As String
Dim myWB As Workbook
Const myPath As String = "D:\プリンタ\"
Application.ScreenUpdating = False
myFile = Dir(myPath & "\" & "Ｐ情報*.xls")
If myFile = "" Then
MsgBox "プリンタで始まるファイルは存在しません。"
Else
With ThisWorkbook.Sheets("プリンタ全情報")
.Cells.ClearContents
End With
Do While myFile <> ""
Set myWB = Workbooks.Open(myPath & myFile)
With myWB.Sheets("プリンタ")
.Range("A1", .Range("C65536").End(xlUp)).Copy _
ThisWorkbook.Sheets("プリンタ全情報").Range("A65536").End(xlUp).Offset(1)
End With
myWB.Close
myFile = Dir()
Loop
End If
Application.ScreenUpdating = True
Set myWB = Nothing
End Sub
-------------------
以上です。
それでは失礼致します。
|
|
ドルフィン
- 06/11/21(火) 23:36 -
