質問編集履歴

1

全体のソースを追記しました

2019/11/24 02:56

投稿

tuckQ
tuckQ

スコア64

test CHANGED
File without changes
test CHANGED
@@ -42,6 +42,178 @@
42
42
 
43
43
  ```
44
44
 
45
+ 全体のソースは下記となります。
46
+
47
+ ```
48
+
49
+ Sub IntegPro()
50
+
51
+
52
+
53
+
54
+
55
+ '変数宣言
56
+
57
+
58
+
59
+ Dim MacroBook As String
60
+
61
+ Dim MacroSht As String
62
+
63
+ Dim InputPath As String
64
+
65
+ Dim OutputPath As String
66
+
67
+ Dim Outputfile As String
68
+
69
+ Dim InputFile As String
70
+
71
+ Dim i As Integer
72
+
73
+ Dim NewBook As String
74
+
75
+ Dim NewSht As String
76
+
77
+ Dim EndRow As Long
78
+
79
+ Dim Endcolumn As Integer
80
+
81
+ Dim DataBook As String
82
+
83
+ Dim Datasht As String
84
+
85
+
86
+
87
+ '実行ファイルとシートの定義
88
+
89
+ MacroBook = ActiveWorkbook.Name
90
+
91
+ MacroSht = ActiveSheet.Name
92
+
93
+
94
+
95
+ '新規ブックを作成し、それのブックとシートを定義する
96
+
97
+ Workbooks.Add
98
+
99
+ NewBook = ActiveWorkbook.Name
100
+
101
+ NewSht = ActiveSheet.Name
102
+
103
+
104
+
105
+ '入力パスや出力パス、出力ファイルの定義
106
+
107
+ With Workbooks(MacroBook).Worksheets(MacroSht)
108
+
109
+ .Activate
110
+
111
+ InputPath = .Cells(2, 3).Value & "\"
112
+
113
+ OutputPath = .Cells(3, 3).Value & "\"
114
+
115
+ Outputfile = .Cells(4, 3).Value
116
+
117
+ End With
118
+
119
+
120
+
121
+ '入力ファイルを定義
122
+
123
+ i = 0
124
+
125
+ Do While Workbooks(MacroBook).Worksheets(MacroSht).Cells(7 + i, 3).Value <> ""
126
+
127
+
128
+
129
+ 'ファイルを開く
130
+
131
+ Workbooks.Open InputPath & Workbooks(MacroBook).Worksheets(MacroSht).Cells(7 + i, 3).Value
132
+
133
+
134
+
135
+ '定義する
136
+
137
+ DataBook = ActiveWorkbook.Name
138
+
139
+ Datasht = ActiveSheet.Name
140
+
141
+
142
+
143
+ 'データファイルの最終行と最終列を記憶する
144
+
145
+ With Workbooks(DataBook).Worksheets(Datasht)
146
+
147
+ EndRow = .Cells(Rows.Count, 1).End(xlUp).Row
148
+
149
+ Endcolumn = .Cells(1, Columns.Count).End(xlToLeft).Column
150
+
151
+
152
+
153
+
154
+
155
+ '開いたファイルのデータ部分をコピペする。(1回目だけデータ名もコピペする)
156
+
157
+ If i = 0 Then
158
+
159
+
160
+
161
+ '1回目だけ
162
+
163
+ .Range(.Cells(1, 1), .Cells(EndRow, Endcolumn)).Copy Workbooks(NewBook).Wroksheets(NewSht).Rows(1)
164
+
165
+
166
+
167
+ Else:
168
+
169
+
170
+
171
+ '2回目以降
172
+
173
+ .Range(.Cells(2, 1), .Cells(EndRow, Endcolumn)).Copy Workbooks(NewBook).Wroksheets(NewSht).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
174
+
175
+
176
+
177
+ End If
178
+
179
+
180
+
181
+ 'データファイルを閉じる
182
+
183
+ Workbooks(DataBook).Close SaveChanges:=False
184
+
185
+
186
+
187
+ End With
188
+
189
+ i = i + 1
190
+
191
+ Loop
192
+
193
+
194
+
195
+ '統合したファイルを名前を付けて保存
196
+
197
+ Workbooks(NewBook).Worksheets(NewSht).Activate
198
+
199
+ ActiveWorkbook.SaveAs Filename:= _
200
+
201
+ OutputPath & Outputfile & ".xlsx", FileFormat:= _
202
+
203
+ xlOpenXMLWorkbook, CreateBackup:=False
204
+
205
+
206
+
207
+
208
+
209
+ '閉じる
210
+
211
+ ActiveWindow.Close
212
+
213
+ End Sub
214
+
215
+ ```
216
+
45
217
 
46
218
 
47
219
  ### 試したこと