質問編集履歴
1
マクロの終生、試したことを具体的に、
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -3,8 +3,8 @@
|
|
|
3
3
|
ファイル名とシート名は年度が入っているので毎年変わることは確定しています。
|
|
4
4
|
|
|
5
5
|
### 発生している問題・エラーメッセージ
|
|
6
|
-
|
|
6
|
+
シートをそのままVer1Bookにコピーしたいのですが、コピーした段階でエラーが発生してしまい動かなくなります。
|
|
7
|
-
|
|
7
|
+
シートの指定やブックの指定など変更して試していますがうまく動きません
|
|
8
8
|
|
|
9
9
|
|
|
10
10
|
```
|
|
@@ -15,88 +15,59 @@
|
|
|
15
15
|
### 該当のソースコード
|
|
16
16
|
|
|
17
17
|
```VBA
|
|
18
|
-
Sub excelcopy()
|
|
19
18
|
|
|
20
|
-
Dim ExcFileName As Variant 'String
|
|
21
|
-
Dim ExcintFree As Integer
|
|
22
|
-
Dim ExcstrRec As String
|
|
23
|
-
Dim ExcstrSplit As String
|
|
24
|
-
Dim k As Long, m As Long, n As Long, o As Long
|
|
25
|
-
Dim ExcWb As Workbook
|
|
26
|
-
|
|
27
19
|
|
|
20
|
+
Sub データ取り込み2()
|
|
28
21
|
|
|
29
|
-
ExcFileName = Application.GetOpenFilename(FileFilter:="Excel ワークシート (*.xlsx),*.xlsx", _
|
|
30
|
-
Title:="Excelファイルの選択")
|
|
31
|
-
|
|
32
22
|
|
|
23
|
+
Application.DisplayAlerts = False ' メッセージを非表示
|
|
24
|
+
|
|
25
|
+
'Sheets2のデータを削除する
|
|
26
|
+
'Sheets(2).Delete
|
|
27
|
+
|
|
28
|
+
Dim OpenFileName As String, FileName As String
|
|
29
|
+
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xlsx")
|
|
33
|
-
|
|
30
|
+
If OpenFileName <> "False" Then
|
|
34
|
-
|
|
31
|
+
Workbooks.Open OpenFileName
|
|
35
|
-
Else
|
|
36
|
-
MsgBox "キャンセルされました"
|
|
37
|
-
'Exit Sub
|
|
38
|
-
End If
|
|
39
32
|
|
|
33
|
+
|
|
40
|
-
|
|
34
|
+
'取り込むエクセルシートを開く
|
|
41
|
-
|
|
35
|
+
Workbooks("Microsoft Excelブック,*.xlsx").Sheets(1).Select.Copy _
|
|
36
|
+
After:=Workbooks("Ver1.xlsm").Sheets(2)
|
|
42
37
|
|
|
38
|
+
FileName = Dir(OpenFileName)
|
|
39
|
+
|
|
43
|
-
|
|
40
|
+
Workbooks(FileName).Close
|
|
44
41
|
|
|
45
|
-
|
|
46
|
-
|
|
42
|
+
Sheets(1).Activate
|
|
43
|
+
|
|
44
|
+
Else
|
|
47
|
-
|
|
45
|
+
MsgBox "データ取り込みがキャンセルされました"
|
|
48
|
-
Worksheets("対象エリア").Range("A2", ActiveCell.SpecialCells(xlLastCell)).ClearContents
|
|
49
|
-
|
|
50
|
-
Set ExcFileName = ExcWb
|
|
51
|
-
|
|
52
|
-
n = Workbooks("ExcWb").Cells(Rows.Count, 1).End(xlUp) 'データ元のシートの最終行の取得【ここでエラー】
|
|
53
|
-
k = 4
|
|
54
|
-
m = 2
|
|
55
|
-
|
|
56
|
-
For o = k To n '４行目から最終行まで繰り返す
|
|
57
46
|
|
|
58
|
-
ExcWb.Activate 'マクロの記録で出たものを変数を入れています。
|
|
59
|
-
Rows(k).Select
|
|
60
|
-
Application.CutCopyMode = False
|
|
61
|
-
Selection.Copy
|
|
62
|
-
thisworkbooks.Activate
|
|
63
|
-
Worksheets("対象エリア").Select
|
|
64
|
-
Cells(m, 1).Select
|
|
65
|
-
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
|
|
66
|
-
:=False, Transpose:=False
|
|
67
|
-
|
|
47
|
+
End If
|
|
68
|
-
m = m + 1
|
|
69
|
-
Next
|
|
70
|
-
|
|
71
|
-
|
|
72
|
-
|
|
73
|
-
|
|
74
|
-
|
|
75
48
|
|
|
76
|
-
|
|
49
|
+
End Sub
|
|
77
|
-
'm = 0
|
|
78
|
-
'Do Until EOF(ExcintFree)
|
|
79
|
-
'Line Input #ExcintFree, ExcstrRec '1行読み込み
|
|
80
|
-
'k = k + 1
|
|
81
|
-
'ExcstrSplit = Split(Replace(ExcstrRec, """", ""), ",") 'カンマ区切りで配列へ
|
|
82
|
-
'For m = 0 To UBound(ExcstrSplit)
|
|
83
|
-
'Cells(k, m + 1) = ExcstrSplit(m)
|
|
84
|
-
'Next
|
|
85
|
-
'エラーメッセージに関しては9行目（I列に出力）
|
|
86
|
-
'Cells(k, 9).Value = ErrMsg_1
|
|
87
|
-
|
|
88
|
-
'Loop
|
|
89
50
|
|
|
90
|
-
End Sub
|
|
91
51
|
|
|
92
|
-
|
|
93
52
|
```
|
|
94
53
|
|
|
95
54
|
|
|
96
55
|
|
|
97
56
|
### 試したこと
|
|
98
|
-
グーグルなど調べて入力していますがどうにもきちんと理解できている気がしません。
|
|
99
57
|
|
|
58
|
+
’Workbooks.Open OpenFileName ’非表示に変更
|
|
59
|
+
|
|
60
|
+
Workbooks(OpenFileName).Sheets(1).Select.Copy _
|
|
61
|
+
After:=Workbooks("Ver1.xlsm").Sheets(2)
|
|
62
|
+
|
|
63
|
+
Workbooks("OpenFileName").Sheets(1).Select.Copy _
|
|
64
|
+
After:=Workbooks("Ver1.xlsm").Sheets(2)
|
|
65
|
+
|
|
66
|
+
Workbooks("Microsoft Excelブック,*.xlsx").Sheets(1).Select.Copy _
|
|
67
|
+
After:=Workbooks("Ver1.xlsm").Sheets(2)
|
|
68
|
+
|
|
69
|
+
と指定のブック名がいけないのかと繰り返していますがどれも有効範囲エラーが出ます。
|
|
70
|
+
|
|
100
71
|
### 補足情報（FW/ツールのバージョンなど）
|
|
101
72
|
|
|
102
73
|
Excel2013
|