回答編集履歴

2

コード追記

2019/09/17 07:28

投稿

hatena19
hatena19

スコア33899

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

コード修正

2019/09/17 07:28

投稿

hatena19
hatena19

スコア33899

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" & 1 & ":A" & SourceLastrow).Copy
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 = ThisWorkBook
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 + 1, 1).PasteSpecial _
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