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

締切り済みの質問

マクロを使ったコピペがうまく動作しない。

あるデータを転記用のブック(月毎にシートが分かれています。シートの内容は同一)に貼り付ける処理を行うため、下記のようなマクロを組んだのですが、何故か貼りつきません。処理終了時には、転記元ブック(シート)で最終処理の範囲(5番目のB287)を選択しています。一体何がいけないのでしょうか?
データはA1からPまでで毎月可変しています。

また、転記用ブックが12枚あるため、月を指定してから貼り付けたいのですが、どのようにすればよいでしょうか?(下記は直接シ-トを指定しました)
Sub test()

Dim 最終行 As Integer
'-------------------------------------------- 開始
Windows("21-12.xls").Activate
最終行 = Range("p65536").End(xlUp).Row
Sheets("1").Range("A1:p" & 最終行).Select
Selection.Copy
Windows("転記.xls").Activate
Sheets(12月).Select
Range("B1").PasteSpecial Paste:=xlPasteValues
'-------------------------------------------- 1

Windows("21-12.xls").Activate
最終行 = Range("p65536").End(xlUp).Row
Sheets("2").Range("A1:p" & 最終行).Select
Selection.Copy
Windows("転記.xls").Activate
Sheets(12月).Select
Range("B83").PasteSpecial Paste:=xlPasteValues
'-------------------------------------------- 2

Windows("21-12.xls").Activate
最終行 = Range("p65536").End(xlUp).Row
Sheets("3").Range("A1:p" & 最終行).Select
Selection.Copy
Windows("転記.xls").Activate
Sheets(12月).Select
Range("B157").PasteSpecial Paste:=xlPasteValues
'-------------------------------------------- 3
Windows("21-12.xls").Activate
最終行 = Range("p65536").End(xlUp).Row
Sheets("4").Range("A1:p" & 最終行).Select
Selection.Copy
Windows("転記.xls").Activate
Sheets(12月).Select
Range("B227").PasteSpecial Paste:=xlPasteValues
'-------------------------------------------- 4

Windows("21-12.xls").Activate
最終行 = Range("p65536").End(xlUp).Row
Sheets("5").Range("A1:p" & 最終行).Select
Selection.Copy
Windows("転記.xls").Activate
Sheets(12月).Select
Range("B287").PasteSpecial Paste:=xlPasteValues
--------------------------------------------- 5
End Sub 

投稿日時 - 2010-01-26 21:58:40

QNo.5625692

すぐに回答ほしいです

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

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

回答(2)

ANo.2

コピーがうまく行かないのは
多分、ブックやシートをちゃんと指定していないからだと思いますよ
例えば
>Windows("21-12.xls").Activate
ブックは指定されてますが
>最終行 = Range("p65536").End(xlUp).Row
シートが指定されていないので
どのシートの最終行を求めているのか分らない
>Sheets("1").Range("A1:p" & 最終行).Select
この選択範囲は???
必要な範囲ではない可能性が有る
>Selection.Copy
したがって、うまく行っていないのでは?

>月を指定してから貼り付けたいのですが・・・
条件が分りません

'取り合えず1~5をまとめただけです
Sub test()
Dim 最終行 As Long
Dim i As Integer
Dim 月 As String

月 = "12月"
'-------------------------------------------- 開始
With Workbooks("21-12.xls")
For i = 1 To 5
With Worksheets(i)
最終行 = .Range("p65536").End(xlUp).Row
.Range("A1:p" & 最終行).Copy _
Workbooks("転記.xls").Worksheets(月).Cells(Rows.Count, 2).End(xlUp).Offset(1)
End With
Next i
End With
'--------------------------------------- 1 2 3 4 5
End Sub

投稿日時 - 2010-01-26 23:33:03

ANo.1

>Sheets(12月).Select
Sheets("12月").Selectで無くても大丈夫?

投稿日時 - 2010-01-26 22:12:27

あなたにオススメの質問