シートをコピーしてなまえをセルからとってくるマクロ

マクロなんて組めないのでメモ。

[green_box]環境:Windows7/Excel2007 たしか2013でも動きます[/green_box]

目的

元データを入力したものをどんどんコピーして使いたい。シート名を回線番号にしたい(今は手作業でコピーしてシート名を変更している) 元データは毎回すべての項目を書き換えてコピーするわけではなく、一部書き換えてまた複製することがある。 コピーしたシートは印刷して別の入力作業に使う

(そんなの、Accessでしたら早いんだろうけど・・・・)

1 元データシートがフォームのようなもので、それに入力してコピーして 項目が変わればそれぞれコピーしていく 最終的にはこの元データシートにマクロ実行ボタンを置きたい(らしい)

B3は回線名(ルールは回線番号+顧客名)なので=CONCATENATE(B4,B5)が入力されている すなわちB3はいじらないセル(隠してもよい)

提案1

元データシートをまるっとコピーして入力していく形 コピーしたシート名は回線番号にする

Sub シートをコピーするマクロ()
Sheets("元データ").Copy After:=ActiveSheet
ActiveSheet.Name = ActiveSheet.Range("B4")
End Sub

問題点

  • 次のシートのために入力しなおすと数値が変わって無意味(特に回線名が関数だし何か一つでもセル参照してたらアウト)
  • エラー処理がない
  • コピー先が元データの右にできるから増えてくるとなんか違う感

提案2

シートを新規作成→名称変更→必要なデータを元データからとってくる

完成イメージ 2 線を引くマクロは別で!!

Sub Newsheet()

  Dim sh_name As String
  Dim n As Long

  sh_name = Sheets("元データ").Range("B4").Value '元データのセル名をシート名にする
    Worksheets.Add After:=Worksheets(Worksheets.Count)  'シートを最後尾に作成

  On Error Resume Next
'同じ名前があったら後ろにカッコ付きで増える処理
  ActiveSheet.Name = sh_name

  n = 1
  Do Until Err.Number = 0
    Err.Clear
    n = n + 1
    ActiveSheet.Name = sh_name & "(" & n & ")"
  Loop

Dim ClipBoard
    ClipBoard = Sheets("元データ").Range("A1:D14")  '元データシートのA1からD14を
    ActiveSheet.Range("A1:D14") = ClipBoard  'アクティブシートのA1からD14へコピー


ActiveSheet.Range("A:C").Columns.AutoFit 'AからCの幅自動調整

ActiveSheet.Range("A3:B14").Borders.LineStyle = True  'A3からB14まで罫線を引く 以下個別に罫線
ActiveSheet.Range("D4").Borders.LineStyle = True
ActiveSheet.Range("D7").Borders.LineStyle = True
ActiveSheet.Range("D9").Borders.LineStyle = True

End Sub

新規シートを作りセルの名前を回線名にします。その際かぶっていると(2)と増えていくようにしています。

↓ここの日付のものを利用。 シートをコピーして名前を変更するExcelマクロ:エクセルマクロ・Excel VBAの使い方-Worksheet・Chartオブジェクト

シートのできる場所も最後尾に。

そして変数で選択範囲をコピー このコピーは値のみ貼り付けと同じですので関数である回線名称も無事に値だけコピーされます。

ActiveSheet.Range("C1").Value = Sheets("元データ").Range("B3").Value '元データの回線名をアクティブのC1にコピー

ひとつひとつ代入していくならこうかな?


自分は提案2の図のように個別にあてはめていくのが完成系と思い↑のような感じで作っていたのですが「全部そのままでいいよ」等と言われてしまったので・・・

書式情報はコピーされないのでセル幅と高さが自動調整されるようにして・・・・

その下の罫線は、指定した範囲に格子 だけでなく、 ほかの回線名をとびとびで入れたりすることがあるから、 とわけのわからないことを言われたので線を引いた

たとえば右の方にセルがばらばら散らばらない小さい表である場合は、入力があるセルに罫線を引く(外側太線)マクロを最後に挿入して・・・

ActiveSheet.Cells.Borders.LineStyle = False
 With ActiveSheet.UsedRange
    .Borders.LineStyle = True
    .BorderAround Weight:=xlMedium

ってそれならシートのコピーが早いか?

提案3

1と2のいいとこどりする。

自分の仕事のために作るわけじゃないから目的や最終的な形が見えてこず提案2のような無駄なことをしてしまった。

提案1のときは、「原本」というシートがあって、あらかじめ元データを参照したシートでそれを複製する というお願いだった。

詳しく聞いてみるとやっぱりシートのコピーでよかった

では1と2を足してはどうじゃ?

Sub Newsheet2()

  Dim sh_name As String
  Dim n As Long

  sh_name = Sheets("元データ").Range("B4").Value '元データのセル名をシート名にする
  ActiveSheet.Copy After:=Sheets(Sheets.Count)  '最後尾にコピー

  On Error Resume Next

  ActiveSheet.Name = sh_name

  n = 1
  Do Until Err.Number = 0
    Err.Clear
    n = n + 1
    ActiveSheet.Name = sh_name & "(" & n & ")"
  Loop

  ActiveSheet.Range("B3").Value = Sheets("元データ").Range("B3").Value '元データの回線名をアクティブのB3にコピー


End Sub

回線名称が関数のままコピーされると意味ないのでシートのコピー後さらにそこだけ値だけ貼り付けにして回避(くにくのさく)

これを使う場合は元データシートの書式を整えておく必要がある。

D列にとびとびでセルに入力することがある(らしい)(どんくらいの頻度であるのそれ?)

  ActiveSheet.Range("D4").Borders.LineStyle = True
ActiveSheet.Range("D7").Borders.LineStyle = True
ActiveSheet.Range("D9").Borders.LineStyle = True

を最後いれてもいい 複数を一つのコードにまとめれるんだろうか 知らないw

そしてメモ欄がいるって言われたような気もするけどもういいだろwどうしてもコピー先にいるって言われたらまた考えよう。

実行ボタンの作成

マクロをボタンに設定してほしいと言われたのでボタンにした(シェイプでもいい)けど・・・

3

これだと元データにボタン置いたらボタンまでコピーされる~! ていうか罫線要ったり要らなかったりならクイックアクセスツールバーに罫線置いてやってくれ(図上部参照)

※案2のシート新規作成マクロなら元データシートにボタン置けるのに

ボタンコピー回避方法 1. クイックアクセスツールバーにマクロ登録する - クイックアクセスツールバーのカスタマイズ→マクロ→マクロ名を選択 - カスタマイズ画面の「変更」ボタンで申し訳程度にアイコンが変えれる 2. ボタンを元データの印刷範囲外に置いて無視しておく

というわけでクイックアクセスに登録して、元データセルで実行してもらうように。コピー先のセルから複製したい場合はシラネ

以上

マクロが全然わからない人が マクロを自力で組めないレベルの私に「人が組んだマクロはセルが隠してあるしどこになにを入れていいかわからない」と言われて単純作業を効率化するためにググって作ってみた。VBAができる人、心の底から尊敬する。