| 
    
     |  | こんにちは。 下のコードを参考書を見ながら作りましたが、
 '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
 
 |  |