回答編集履歴

1

同様の質問とその回答を見つけました。

2019/04/27 21:58

投稿

SnowMonkey
SnowMonkey

スコア53

test CHANGED
@@ -1,101 +1,7 @@
1
- 私も初心者です。私も同様のこと実現たくググって自分の目的に合わせほんの少しけ変えたものが以下のものです。私も参照先の方に失礼と思いすが、参照先が分からなくなってまいましし、質問者様のおばと思いので、手元のコードを紹介します。
1
+ 私も同様な質問をして、回答いたました質問者さまにも役立つかもしれませんので
2
+
3
+ 参照してみてください。
2
4
 
3
5
 
4
6
 
5
- ```Excel VBA
6
-
7
-
8
-
9
- Option Explicit
10
-
11
-
12
-
13
- '「data」フォルダにあるファイルを開いて、その内容をこのワークブックにまとめる
14
-
15
- Sub importData()
16
-
17
- Dim fso As FileSystemObject
18
-
19
- Set fso = New FileSystemObject
20
-
21
-
22
-
23
-
24
-
25
- Dim f As File
26
-
27
- For Each f In fso.GetFolder(ThisWorkbook.Path & "\data").Files 'dataフォルダにあるファイルを1つずつ開いて処理
28
-
29
- With Workbooks.Open(f.Path)
30
-
31
- Dim bkName As String
32
-
33
- bkName = .Name
34
-
35
-
36
-
37
- Dim i As Long
38
-
39
- For i = 1 To Worksheets.Count ' 全シートを処理する
40
-
41
- With .Worksheets("Sheet" & i)
42
-
43
-
44
-
45
- '----------データの複写先のシートの最終行を取得--------------------
46
-
47
- Dim wsResult As Worksheet
48
-
49
- Set wsResult = ThisWorkbook.Worksheets("Sheet" & i) 'データの複写先のシート
50
-
51
-
52
-
53
- Dim LastRow As Long
54
-
55
- LastRow = wsResult.Cells(Rows.Count, 3).End(xlUp).row 'データの複写先のシートの最終行
56
-
57
-
58
-
59
- '------開いたシートの使用されている範囲を、複写先シートの最終行の次行にコピーする A列とB列は空欄にしておく------------
60
-
61
- .UsedRange.Copy wsResult.Cells(LastRow + 1, 3) '3列目つまりC列に
7
+ https://teratail.com/questions/171219#
62
-
63
-
64
-
65
- '------データを追加した範囲のA列B列にブック名から抜き出した情報を書き込む------------
66
-
67
- Dim LastRow2 As Long
68
-
69
- LastRow2 = wsResult.Cells(Rows.Count, 3).End(xlUp).row 'データの複写先のシートの最終行を再び取得して
70
-
71
- wsResult.Range(wsResult.Cells(LastRow + 1, 1), wsResult.Cells(LastRow2, 1)).Value = Left(bkName, 2)
72
-
73
- wsResult.Range(wsResult.Cells(LastRow + 1, 2), wsResult.Cells(LastRow2, 2)).Value = Mid(bkName, 3, 2)
74
-
75
-
76
-
77
- End With
78
-
79
- Next i
80
-
81
- .Close
82
-
83
-
84
-
85
- End With
86
-
87
-
88
-
89
- Next f
90
-
91
-
92
-
93
- End Sub
94
-
95
-
96
-
97
-
98
-
99
-
100
-
101
- ```