回答編集履歴
2
コード追記
test
CHANGED
|
@@ -80,4 +80,54 @@
|
|
|
80
80
|
|
|
81
81
|
|
|
82
82
|
|
|
83
|
-
RunTestCopyDataがエラーなく実行されることが確認出来たら、ループ処理のコーディング
|
|
83
|
+
RunTestCopyDataがエラーなく実行されることが確認出来たら、ループ処理のコーディングへ移行します。
|
|
84
|
+
|
|
85
|
+
|
|
86
|
+
|
|
87
|
+
---
|
|
88
|
+
|
|
89
|
+
CopyDataプロシージャが問題なく実行できたら、ループ処理は下記のようになります。
|
|
90
|
+
|
|
91
|
+
list.xlsxのパスは実際のものに変更してください。
|
|
92
|
+
|
|
93
|
+
|
|
94
|
+
|
|
95
|
+
```vba
|
|
96
|
+
|
|
97
|
+
Sub CopyBooksData()
|
|
98
|
+
|
|
99
|
+
Application.ScreenUpdating = False
|
|
100
|
+
|
|
101
|
+
|
|
102
|
+
|
|
103
|
+
Dim listWB As Workbook
|
|
104
|
+
|
|
105
|
+
Set listWB = Workbooks.Open("C:\test\list.xlsx")
|
|
106
|
+
|
|
107
|
+
Dim listLastrow As Long
|
|
108
|
+
|
|
109
|
+
listLastrow = listWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
|
|
110
|
+
|
|
111
|
+
Dim listRng As Range
|
|
112
|
+
|
|
113
|
+
Set listRng = listWB.Worksheets("Sheet1").Range("A1").Resize(listLastrow)
|
|
114
|
+
|
|
115
|
+
|
|
116
|
+
|
|
117
|
+
Dim wbPathRng As Range
|
|
118
|
+
|
|
119
|
+
For Each wbPathRng In listRng
|
|
120
|
+
|
|
121
|
+
Call CopyData(wbPathRng.Value)
|
|
122
|
+
|
|
123
|
+
Next
|
|
124
|
+
|
|
125
|
+
|
|
126
|
+
|
|
127
|
+
listWB.Close False
|
|
128
|
+
|
|
129
|
+
Application.ScreenUpdating = True
|
|
130
|
+
|
|
131
|
+
End Sub
|
|
132
|
+
|
|
133
|
+
```
|
1
コード修正
test
CHANGED
|
@@ -32,35 +32,33 @@
|
|
|
32
32
|
|
|
33
33
|
Dim SourceLastrow As Long
|
|
34
34
|
|
|
35
|
-
SourceLastrow = SourceWB.Cells(Rows.Count, "A").End(xlUp).Row
|
|
35
|
+
SourceLastrow = SourceWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
|
|
36
36
|
|
|
37
|
-
'コピー元データコピー
|
|
38
37
|
|
|
38
|
+
|
|
39
|
-
SourceWB.Worksheets("Sheet1").Range("A
|
|
39
|
+
SourceWB.Worksheets("Sheet1").Range("A1").Resize(SourceLastrow).Copy
|
|
40
40
|
|
|
41
41
|
|
|
42
42
|
|
|
43
43
|
Dim TargetWB As Workbook
|
|
44
44
|
|
|
45
|
-
Set TargetWB = ThisWork
|
|
45
|
+
Set TargetWB = ThisWorkbook
|
|
46
46
|
|
|
47
47
|
Dim TargetLastrow As Long
|
|
48
48
|
|
|
49
|
-
TargetLastrow = TargetWB.Cells(Rows.Count, "A").End(xlUp).Row
|
|
49
|
+
TargetLastrow = TargetWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
|
|
50
50
|
|
|
51
|
-
'貼り付け先にペースト
|
|
52
51
|
|
|
52
|
+
|
|
53
|
-
TargetWB.Worksheets("Sheet1").Cells(TargetLastrow
|
|
53
|
+
TargetWB.Worksheets("Sheet1").Cells(TargetLastrow, 1).PasteSpecial _
|
|
54
54
|
|
|
55
55
|
xlPasteValuesAndNumberFormats
|
|
56
56
|
|
|
57
57
|
|
|
58
58
|
|
|
59
|
-
Application.CutCopyMode = False
|
|
59
|
+
Application.CutCopyMode = False
|
|
60
60
|
|
|
61
61
|
SourceWB.Close False
|
|
62
|
-
|
|
63
|
-
|
|
64
62
|
|
|
65
63
|
End Sub
|
|
66
64
|
|