回答編集履歴
2
コード追記
answer
CHANGED
|
@@ -39,4 +39,29 @@
|
|
|
39
39
|
End Sub
|
|
40
40
|
```
|
|
41
41
|
|
|
42
|
-
RunTestCopyDataがエラーなく実行されることが確認出来たら、ループ処理のコーディング
|
|
42
|
+
RunTestCopyDataがエラーなく実行されることが確認出来たら、ループ処理のコーディングへ移行します。
|
|
43
|
+
|
|
44
|
+
---
|
|
45
|
+
CopyDataプロシージャが問題なく実行できたら、ループ処理は下記のようになります。
|
|
46
|
+
list.xlsxのパスは実際のものに変更してください。
|
|
47
|
+
|
|
48
|
+
```vba
|
|
49
|
+
Sub CopyBooksData()
|
|
50
|
+
Application.ScreenUpdating = False
|
|
51
|
+
|
|
52
|
+
Dim listWB As Workbook
|
|
53
|
+
Set listWB = Workbooks.Open("C:\test\list.xlsx")
|
|
54
|
+
Dim listLastrow As Long
|
|
55
|
+
listLastrow = listWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
|
|
56
|
+
Dim listRng As Range
|
|
57
|
+
Set listRng = listWB.Worksheets("Sheet1").Range("A1").Resize(listLastrow)
|
|
58
|
+
|
|
59
|
+
Dim wbPathRng As Range
|
|
60
|
+
For Each wbPathRng In listRng
|
|
61
|
+
Call CopyData(wbPathRng.Value)
|
|
62
|
+
Next
|
|
63
|
+
|
|
64
|
+
listWB.Close False
|
|
65
|
+
Application.ScreenUpdating = True
|
|
66
|
+
End Sub
|
|
67
|
+
```
|
1
コード修正
answer
CHANGED
|
@@ -15,21 +15,20 @@
|
|
|
15
15
|
Dim SourceWB As Workbook
|
|
16
16
|
Set SourceWB = Workbooks.Open(wbPath)
|
|
17
17
|
Dim SourceLastrow As Long
|
|
18
|
-
SourceLastrow = SourceWB.Cells(Rows.Count, "A").End(xlUp).Row
|
|
18
|
+
SourceLastrow = SourceWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
|
|
19
|
-
'コピー元データコピー
|
|
20
|
-
SourceWB.Worksheets("Sheet1").Range("A" & 1 & ":A" & SourceLastrow).Copy
|
|
21
19
|
|
|
20
|
+
SourceWB.Worksheets("Sheet1").Range("A1").Resize(SourceLastrow).Copy
|
|
21
|
+
|
|
22
22
|
Dim TargetWB As Workbook
|
|
23
|
-
Set TargetWB =
|
|
23
|
+
Set TargetWB = ThisWorkbook
|
|
24
24
|
Dim TargetLastrow As Long
|
|
25
|
-
TargetLastrow = TargetWB.Cells(Rows.Count, "A").End(xlUp).Row
|
|
25
|
+
TargetLastrow = TargetWB.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
|
|
26
|
-
|
|
26
|
+
|
|
27
|
-
TargetWB.Worksheets("Sheet1").Cells(TargetLastrow
|
|
27
|
+
TargetWB.Worksheets("Sheet1").Cells(TargetLastrow, 1).PasteSpecial _
|
|
28
28
|
xlPasteValuesAndNumberFormats
|
|
29
29
|
|
|
30
|
-
Application.CutCopyMode = False
|
|
30
|
+
Application.CutCopyMode = False
|
|
31
31
|
SourceWB.Close False
|
|
32
|
-
|
|
33
32
|
End Sub
|
|
34
33
|
|
|
35
34
|
'上記プロシージャの動作確認
|