こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel vba selectが効かない

2と3の2つのエクセルファイルがあります。縦の列を新しいファイルの横の行に
コピーしていきたいプログラムです。
2のファイルの1シート目の"C8:C25"
3のファイルの1シート目の"C9:C65"
を新しい1のファイルの1シート目の1行目にコピーするプログラムを
作っていますが1シート目はpasteされるのですが
3のファイル2シート目からselectの指定が"C9:C65"ではなく、B9からQ65の指定になってしまい思ったコピーができません(★のところ)、1シート目はうまくいっているのでどうして3のファイルの2シート目のからうまくいかないかわかりません。
5シートまででテストをしているのですが実際は各々255シートありもってくる列も
12列あります。とりあえずCの列だけ5シートで試してみています。
Dim i As Long
Dim N As Long
i = 1
N = 1
Do While i <= 5
''C列'''
Workbooks(2).Worksheets(i).Activate   '2のファイル
Worksheets(i).Range("C8:C25").Select   'もってくるところ
Selection.Copy

Workbooks(1).Worksheets(1).Activate   '1新しいファイル
Range("C" & N).Select   '貼り付けるところ
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True
Workbooks(3).Worksheets(i).Activate   '3のファイル
Workbooks(3).Worksheets(i).Range("C9:C65").Select  '★もってくるところ
Selection.Copy
Workbooks(1).Worksheets(1).Activate   '1新しいファイル
Range("U" & N).Select   '貼り付けるところ
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True
i=i+1
N=N+1
LOOP

投稿日時 - 2020-06-11 21:03:35

QNo.9759775

すぐに回答ほしいです

質問者が選んだベストアンサー

No2の余計なお世話の追加です。

No2はデータのコピペのイメージを残したコード(実際はコピペではありませんが)ですが、それを省いて直接代入するようにしてもいいと思います。

Sub Test()
Dim i As Long
Dim N As Long
i = 1
N = 1
With Workbooks(1).Worksheets(1)
Do While i <= 5
''C列'''
.Range("C" & N).Resize(1, 18).Value = WorksheetFunction.Transpose(Workbooks(2).Worksheets(i).Range("C8:C25").Value)
.Range("U" & N).Resize(1, 57).Value = WorksheetFunction.Transpose(Workbooks(3).Worksheets(i).Range("C9:C65").Value)
i = i + 1
N = N + 1
Loop
End With
End Sub

投稿日時 - 2020-06-12 13:44:07

お礼

.selectをやめて.copyにしましたら正常に
動きました。ありがとうございます。
とても助かりました。

投稿日時 - 2020-06-12 18:18:11

ANo.3

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

> 開いた順のWorksheets(1)でファイル名は指定していません。

質問のコードの部分だけで見るとちょっと怖い気もします(私の場合Workbooks(1)はPERSONAL.XLSBになります)
Selectがおかしいのは、連続でコピペすると環境によっては変なエラーになったりしますのでその影響かもしれません(Selectではありませんが過去に変なエラーになるという事例がありましたその時はDoEvents()を入れて良くなったみたいでした)

余計なお世話だと思いますが、改善されない場合以下のようにしてみてはいかがでしょう。

Sub Test()
Dim i As Long
Dim N As Long
Dim TmpData1 As Variant, TmpData2 As Variant
i = 1
N = 1
With Workbooks(1).Worksheets(1)
Do While i <= 5
''C列'''
TmpData1 = Workbooks(2).Worksheets(i).Range("C8:C25").Value 'もってくるところ
.Range("C" & N).Resize(1, 18).Value = WorksheetFunction.Transpose(TmpData1) '貼り付けるところ
TmpData2 = Workbooks(3).Worksheets(i).Range("C9:C65").Value '★もってくるところ
.Range("U" & N).Resize(1, 57).Value = WorksheetFunction.Transpose(TmpData2) '貼り付けるところ
i = i + 1
N = N + 1
Loop
End With
End Sub

投稿日時 - 2020-06-12 13:19:50

ANo.1

こちらでテストしたところ正常にコピペできました。
コードは標準モジュールにあるとして、Workbooks(1)などは本来のブック名にしてるんですよね。
Workbooks(3).Worksheets(i).Range("C9:C65").Select  
で止めて選択された範囲がB9からQ65だったということでしょうか。
たとえば
Worksheets(i).Range("C8:C25").Select   'もってくるところ
Selection.Copy

Worksheets(i).Range("C8:C25").Copy
のように.PasteSpecialの所も含めて全て変更してみてはいかがでしょう。

投稿日時 - 2020-06-11 22:48:34

補足

回答ありがとうございます。
「Workbooks(1)などは本来のブック名にしてるんですよ」
は開いた順のWorksheets(1)でファイル名は指定していません。
「Range("C9:C65").Select」の指定を止めてみると ("B9:Q65")が
SELECTされているのです。
2ファイル目はうまくコピーできてまして3ファイル目のRange("C9:C65").Select
がおかしいのでご指摘のようにCOPYで試してます。

投稿日時 - 2020-06-12 12:09:38

あなたにオススメの質問