Sample Macro  コピー [応用型] Previous Next

1) グラフのコピー貼り付け このページのトップへ もくじへ 使用可能なExcelのバージョン
'---------------------------------------------------------------------------------
Sub グラフを図としてコピーし他のブックへ貼り付ける()
    Windows("コピー元ブック.xls").Activate      '※1
    Sheets("グラフ").Select                     '※1
        ActiveSheet.ChartObjects(1).Activate    'ワークシートの埋め込みグラフをアクティブに
        ActiveChart.ChartArea.Select            'グラフエリアを選択する
        ActiveChart.CopyPicture Appearance:=xlScreen, _
            Size:=xlScreen, Format:=xlPicture   '※2 クリップボードへ図としてコピー

    Windows("貼り付け先ブック.xls").Activate    '※3
    Sheets("グラフ").Select                     '※3
        ActiveSheet.Pictures.Paste              '図の貼り付け
End Sub
'---------------------------------------------------------------------------------
<コメント>
※1 コピー元のブック名、シート名を指定する
※2 CopyPictureメソッドの引数は こちら
※3 貼り付け先のブック名、シート名を指定する


2) ネットワークドライブのブックに貼り付け このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub ネットワークドライブのブックに貼り付ける()
    Windows("BBB.xls").Activate                 '複写元のブックをアクティブにする ※1
    Sheets("SSS").Select                        '複写元のシートを選ぶ ※2
        Cells.Copy                              'シート全体をコピーする
    ChDrive "E"                                 'LANのドライブに切り替え ※3
    ChDir "E:\"                                 'LANのディレクトリに切り替え ※3 ※4
    Workbooks.Open Filename:="E:\BB2.xls"       '複写先のブックを開く ※5
    Sheets("SS2").Select                        '複写先のシートを選ぶ ※6
        Range("A1").Select
            Selection.PasteSpecial Paste:=xlAll 'すべて貼り付け
        ActiveWorkbook.Save                     '上書き保存
        Application.DisplayAlerts = False       'メッセージを出さない
        ActiveWorkbook.Close                    '閉じる
End Sub
'================================================================================= 
<コメント>
※1 BBBには複写元ブック名を記入する
※2 SSSには複写元シート名を記入する
※3 Eにはネットワークドライブに割り当てられているドライブ名を記入する
※4 \には複写先ブックが格納されているフォルダー名までを必要により記入する
※5 BB2には複写先ブック名を記入する
※6 SS2には複写先シート名を記入する
※7 ブック、シート名をその都度変えたい場合の参考 「指定ブックの指定シートをアクティブにする


3) オートフィルターしてコピーする このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Option Explicit
Dim 元シート As String                          'オートフィルターするシート名
Dim 列番号 As Integer                           'オートフィルターする列番号
Dim 条件1 As String                             'オートフィルターの抽出条件式1
Dim 条件2 As String                             'オートフィルターの抽出条件式2
Dim 論理式 As String                            '抽出条件式間の論理指定
Dim キー位置 As String                          '抜き出し項目列の上端セル
Dim 新シート As String                          '抜き出し結果を貼り付けるシート名 ※1
Dim 貼付位置 As String                          '抜き出し結果を貼り付ける左上角セル
'---------------------------------------------------------------------------------
Sub オートフィルターした結果をコピーして貼り付ける()
    元シート = "SS1"                            '※1
        条件1 = ">=" & "19971201"               '※2
        条件2 = "<=" & "19980131"               '※3
        論理式 = "AND"                          '※4
        キー位置 = "E1"                         '※5
    新シート = "SS2"                            '※6
        貼付位置 = "A1"                         '※7
    Sheets(元シート).Select                     'フィルターするシート
        Range(キー位置).Select                  '左上角
            Selection.AutoFilter                'オートフィルターをリセット
            Selection.AutoFilter Field:=2, Criteria1:="A" 'この場合は2列目がAを抜き出し
            Selection.CurrentRegion.Copy        'アクティブセル領域をコピー
    Sheets(新シート).Select                        '結果を貼り付けるシート
        Range(貼付位置).PasteSpecial Paste:=xlAll   'すべて貼り付け
End Sub
'=================================================================================
<コメント>
※1 SS1にはオートフィルターするシート名を記入
※2 条件1は19971201以上の意味
※3 条件2は19980131以下の意味
※4 AND条件…※2以上でかつ※3以下の意味
※5 E1にはオートフィルターするシートのキー位置を記入
※6 SS2には抜き出した結果を写し込むシート名を記入
※7 同上の貼り付け位置の左上角のセル名を記入
※8 オートフィルターするシートに結合されたセルがあると、コピー貼り付けできない



4) 列幅と行高を新規ブックのシートへコピー このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub シートの列幅と行高を新規ブックのシートへコピーする()
    Worksheets("SSS").Cells.Copy                '※1 すべてのセルをコピー
    Workbooks.Add                               'ブックを新規作成
        Range("A1").PasteSpecial Paste:=xlPasteAll 'すべて貼り付ける
        Cells.Clear                             'すべてクリア
End Sub
'=================================================================================
<コメント>
※1 SSSにはコピーするシート名を記入

Excel VBA Macro









VBAの本 こちら













マクロ本 こちら













Excel本 こちら