| |
こんにちは。
下のコードを参考書を見ながら作りましたが、
'１３.xlsを開く から下に１７行目の
Selection.PasteSpecial Paste:=xlValues '値のみ貼付け
の部分でエラーになります。
エラーの内容は、
実行時エラー'1004'
コピー領域と貼り付け領域の形が違うため、情報を貼り付けることができません。
情報を貼り付けるに９は、次のいづれかの操作を行ってください：
？1つのセルをクリックし、貼り付けてみてください。
？貼り付け元の形を確かめ、適切な範囲を選択したあと、貼り付けてみてください。
です。
エラーの原因は'１３.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 'ブックを閉じる
'１３.xlsを開く
Workbooks.Open Filename:= _
"\\kkk\hh\III\YY\DDDDD\DDD\PPPPP\１３.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("１３.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("１３.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 'ブックを閉じる
'１４.xlsを開く
Workbooks.Open Filename:= _
"\\kkk\hh\III\YY\DDDDD\DDD\PPPPP\１４.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("１４.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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
