|
こんにちは。
下のコードを参考書を見ながら作りましたが、
'13.xlsを開く から下に17行目の
Selection.PasteSpecial Paste:=xlValues '値のみ貼付け
の部分でエラーになります。
エラーの内容は、
実行時エラー'1004'
コピー領域と貼り付け領域の形が違うため、情報を貼り付けることができません。
情報を貼り付けるに9は、次のいづれかの操作を行ってください:
?1つのセルをクリックし、貼り付けてみてください。
?貼り付け元の形を確かめ、適切な範囲を選択したあと、貼り付けてみてください。
です。
エラーの原因は'13.xlsのSheets:QCの13行目から下にはデーターが無いのですが、
最後の行(65536)まで選択して張り付ける作業を行うからだと思っているのですが・・・
(その他.xlsにはデーターがあり、集計.xlsにそのデータが貼り付けられます。)
こういう場合の対処方法をご指導いただけないでしょうか?
=================================================================
Sub 値だけ貼付け()
Application.ScreenUpdating = False '画面を更新しない
'その他.xlsを開く
Workbooks.Open Filename:= _
"\\kkk\hh\III\YY\DDDDD\DDD\PPPPP\その他.xls", UpdateLinks _
:=0
'コピーする
Sheets("その他").Select
Range("A13:L13").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'貼りつける
Windows("集計.xls").Activate
Sheets("集計").Select
Range("A13").Select
Selection.PasteSpecial Paste:=xlValues '値のみ貼付け
'開いたブックをセーブして閉じる
Windows("その他.xls").Activate
Application.CutCopyMode = False
Cells(65536, 1).Select
Selection.End(xlUp).Select '最終セルの取得
ActiveCell.Offset(1, 0).Activate '最終セルの1つ下のセルを指定
ActiveWorkbook.Save 'ブックを保存
ActiveWindow.Close 'ブックを閉じる
'13.xlsを開く
Workbooks.Open Filename:= _
"\\kkk\hh\III\YY\DDDDD\DDD\PPPPP\13.xls", _
UpdateLinks:=0
'コピーする(Sheets:QC)
Sheets("QC").Select
Range("A13:L13").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'貼りつける
Windows("集計.xls").Activate
Sheets("集計").Select
Cells(65536, 1).Select
Selection.End(xlUp).Select '最終セルの取得
ActiveCell.Offset(1, 0).Activate '最終セルの1つ下のセルを指定
Selection.PasteSpecial Paste:=xlValues '値のみ貼付け
Windows("13.xls").Activate
Sheets("QC").Select
Application.CutCopyMode = False
Cells(65536, 1).Select
Selection.End(xlUp).Select '最終セルの取得
ActiveCell.Offset(1, 0).Activate '最終セルの1つ下のセルを指定
'コピーする(Sheets:AA)
Sheets("AA").Select
Range("A13:L13").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'貼りつける
Windows("集計.xls").Activate
Sheets("集計").Select
Cells(65536, 1).Select
Selection.End(xlUp).Select '最終セルの取得
ActiveCell.Offset(1, 0).Activate '最終セルの1つ下のセルを指定
Selection.PasteSpecial Paste:=xlValues '値のみ貼付け
Windows("13.xls").Activate
Sheets("AA").Select
Application.CutCopyMode = False
Cells(65536, 1).Select
Selection.End(xlUp).Select '最終セルの取得
ActiveCell.Offset(1, 0).Activate '最終セルの1つ下のセルを指定
'開いたブックをセーブして閉じる
ActiveWorkbook.Save 'ブックを保存
ActiveWindow.Close 'ブックを閉じる
'14.xlsを開く
Workbooks.Open Filename:= _
"\\kkk\hh\III\YY\DDDDD\DDD\PPPPP\14.xls", UpdateLinks _
:=0
'コピーする
Sheets("BB").Select
Range("A13:L13").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'貼りつける
Windows("集計.xls").Activate
Sheets("集計").Select
Cells(65536, 1).Select
Selection.End(xlUp).Select '最終セルの取得
ActiveCell.Offset(1, 0).Activate '最終セルの1つ下のセルを指定
Selection.PasteSpecial Paste:=xlValues '値のみ貼付け
'開いたブックをセーブして閉じる
Windows("14.xls").Activate
Sheets("BB").Select
Application.CutCopyMode = False
Cells(65536, 1).Select
Selection.End(xlUp).Select '最終セルの取得
ActiveCell.Offset(1, 0).Activate '最終セルの1つ下のセルを指定
ActiveWorkbook.Save 'ブックを保存
ActiveWindow.Close 'ブックを閉じる
End Sub
|
|