teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップに関する質問別ブックの指定位置からDBのエクセルシートへコピーしたい

編集履歴

質問編集履歴

1

マクロの終生、試したことを具体的に、

2020/07/16 02:23

投稿

Task_0513
Task_0513

スコア1

test CHANGED
File without changes
test CHANGED
@@ -8,9 +8,9 @@
8
8
 
9
9
  ### 発生している問題・エラーメッセージ
10
10
 
11
- そもそもとして、選択ファイルを変数にしたいんですがそれがうまくいっているのか、わからない。
11
+ シートをそのままVer1Bookにコピーしたいのですが、コピーした段階でエラーが発生してしまい動かなくなります。
12
12
 
13
- データ元のエクセルは、B4：H4までにデータが入っていて最終行はその年ごとに変わります。
13
+ シートの指定やブックの指定など変更して試していますがうまく動きません
14
14
 
15
15
 
16
16
 
@@ -32,151 +32,69 @@
32
32
 
33
33
  ```VBA
34
34
 
35
- Sub excelcopy()
36
35
 
37
36
 
38
37
 
39
- Dim ExcFileName As Variant 'String
40
38
 
41
- Dim ExcintFree As Integer
42
-
43
- Dim ExcstrRec As String
44
-
45
- Dim ExcstrSplit As String
46
-
47
- Dim k As Long, m As Long, n As Long, o As Long
48
-
49
- Dim ExcWb As Workbook
39
+ Sub データ取り込み2()
50
-
51
-
52
40
 
53
41
 
54
42
 
55
43
 
56
44
 
57
- ExcFileName = Application.GetOpenFilename(FileFilter:="Excel ワークシート (*.xlsx),*.xlsx", _
45
+ Application.DisplayAlerts = False ' メッセージを非表示
58
46
 
59
- Title:="Excelファイルの選択")
47
+
60
48
 
61
-
49
+ 'Sheets2のデータを削除する
62
50
 
51
+ 'Sheets(2).Delete
63
52
 
53
+
64
54
 
65
- If ExcFileName <> False Then
55
+ Dim OpenFileName As String, FileName As String
66
56
 
67
- 'Workbooks.Open ExcFileName
57
+ OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xlsx")
68
58
 
69
- Else
59
+ If OpenFileName <> "False" Then
70
60
 
71
- MsgBox "キャンセルされました"
72
-
73
- 'Exit Sub
74
-
75
- End If
76
-
77
-
78
-
79
- ExcintFree = FreeFile '空番号を取得
80
-
81
- Open ExcFileName For Input As #ExcintFree 'Excelファィルをオープン
82
-
83
-
84
-
85
- '既存の記載内容を削除する
86
-
87
-
88
-
89
-
90
-
91
- ThisWorkbook.Activate
92
-
93
- Worksheets("対象エリア").Select
94
-
95
- Worksheets("対象エリア").Range("A2", ActiveCell.SpecialCells(xlLastCell)).ClearContents
96
-
97
-
98
-
99
- Set ExcFileName = ExcWb
100
-
101
-
102
-
103
- n = Workbooks("ExcWb").Cells(Rows.Count, 1).End(xlUp) 'データ元のシートの最終行の取得【ここでエラー】
104
-
105
- k = 4
106
-
107
- m = 2
108
-
109
-
110
-
111
- For o = k To n '４行目から最終行まで繰り返す
112
-
113
-
114
-
115
- ExcWb.Activate　　　　　'マクロの記録で出たものを変数を入れています。
116
-
117
- Rows(k).Select
118
-
119
- Application.CutCopyMode = False
120
-
121
- Selection.Copy
122
-
123
- thisworkbooks.Activate
61
+ Workbooks.Open OpenFileName
124
-
125
- Worksheets("対象エリア").Select
126
-
127
- Cells(m, 1).Select
128
-
129
- Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
130
-
131
- :=False, Transpose:=False
132
-
133
- k = k + 1
134
-
135
- m = m + 1
136
-
137
- Next
138
-
139
-
140
-
141
-
142
-
143
-
144
-
145
-
146
62
 
147
63
 
148
64
 
149
65
 
150
66
 
151
- 'k = 3
67
+ '取り込むエクセルシートを開く
152
68
 
153
- 'm = 0
69
+ Workbooks("Microsoft Excelブック,*.xlsx").Sheets(1).Select.Copy _
154
70
 
155
- 'Do Until EOF(ExcintFree)
156
-
157
- 'Line Input #ExcintFree, ExcstrRec '1行読み込み
158
-
159
- 'k = k + 1
160
-
161
- 'ExcstrSplit = Split(Replace(ExcstrRec, """", ""), ",") 'カンマ区切りで配列へ
162
-
163
- 'For m = 0 To UBound(ExcstrSplit)
71
+ After:=Workbooks("Ver1.xlsm").Sheets(2)
164
-
165
- 'Cells(k, m + 1) = ExcstrSplit(m)
166
-
167
- 'Next
168
-
169
- 'エラーメッセージに関しては9行目（I列に出力）
170
-
171
- 'Cells(k, 9).Value = ErrMsg_1
172
-
173
-
174
-
175
- 'Loop
176
72
 
177
73
 
178
74
 
75
+ FileName = Dir(OpenFileName)
76
+
77
+
78
+
79
+ Workbooks(FileName).Close
80
+
81
+
82
+
83
+ Sheets(1).Activate
84
+
85
+
86
+
87
+ Else
88
+
89
+ MsgBox "データ取り込みがキャンセルされました"
90
+
91
+
92
+
93
+ End If
94
+
95
+
96
+
179
- End Sub
97
+ End Sub
180
98
 
181
99
 
182
100
 
@@ -192,7 +110,31 @@
192
110
 
193
111
  ### 試したこと
194
112
 
113
+
114
+
115
+ ’Workbooks.Open OpenFileName　　’非表示に変更
116
+
117
+
118
+
119
+ Workbooks(OpenFileName).Sheets(1).Select.Copy _
120
+
121
+ After:=Workbooks("Ver1.xlsm").Sheets(2)
122
+
123
+
124
+
125
+ Workbooks("OpenFileName").Sheets(1).Select.Copy _
126
+
127
+ After:=Workbooks("Ver1.xlsm").Sheets(2)
128
+
129
+
130
+
131
+ Workbooks("Microsoft Excelブック,*.xlsx").Sheets(1).Select.Copy _
132
+
133
+ After:=Workbooks("Ver1.xlsm").Sheets(2)
134
+
135
+
136
+
195
- グーグルなど調べて入力していますがどうにもきちんと理解できている気がしません。
137
+ と指定のブック名がいけないのかと繰り返していますがどれも有効範囲エラーが出ます。
196
138
 
197
139
 
198
140