こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

アドバイスをお願いします(VBAで・・・)

Excel2010を使用。
現在".xlsm"ファイルに
シートが複数あります。
この中の一つのシートだけを新たなBookにコピーして、
名前を付けて保存する際、Book名を、"L5"セルにある文字列に
したいと思い、ググった結果、下記のコードにたどりつきました。

このコードだけだと"close"の時にダイアログがでてくるので、
これに
ActiveWorkbook.SaveAs Filename:="フォルダ名" & Range("L5").Value & ".xlsx"

をCloseの前に挿入してみたのですが、Range("L5").Value=Empty値となり
エラーがでてしまいます。
VBA初心者であるため、改善策がわからず苦戦しております。
申し訳ありませんが、アドバイスいただけないでしょうか?

Sub サンプル()
Dim sc As Integer
sc = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
ThisWorkbook.Sheets("オリジナル").Cells.Copy 'コピー
Workbooks.Add 'ブック追加
Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlValues '値貼り付け
Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlFormats '書式貼り付け
Sheets("Sheet1").Name = "コピー"
Application.CutCopyMode = False
Application.SheetsInNewWorkbook = sc
ActiveWorkbook.Close
ThisWorkbook.Activate
End Sub

参考URL:http://okwave.jp/qa/q2167570.html

※コピーしたいのは、シートの中のデータ、書式だけなので
マクロを必要としません。

投稿日時 - 2012-08-23 10:44:07

QNo.7658747

すぐに回答ほしいです

質問者が選んだベストアンサー

>ひとつだけ、行の高さが16行目までは完璧なのですが、
>17行目以降が違う高さ(低く)なってしまいました。
手元にExcel2010が有りませんので症状は解りませんが
http://answers.microsoft.com/ja-jp/office/forum/office_2010-excel/excel2010%E3%81%A7%E8%A1%8C%E9%96%93%E3%81%8C/124269ca-455b-e011-8dfc-68b599b31bf5
【EXCEL2010で行間が勝手に広がる】
こんな事があるようですね

投稿日時 - 2012-08-23 15:23:53

お礼

watabe007さん、度々の回答ありがとうございます。
教えていただいたサイトに記載がある内容を
試しましたが、修復できませんでした。
ただ、自分なりに考えた結果、
Sheets(1).Range("A1").PasteSpecial Paste:=xlFormats
'書式貼り付け
このあとに、行の高さを設定するコードを付け足したところ
改善することができました。
度重なる質問に応じていただき本当に感謝です。
ありがとうございました。

投稿日時 - 2012-08-23 15:53:42

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.3

("L5").Value & ".xls"

("L5").Value & ".xlsx"

投稿日時 - 2012-08-23 14:19:33

補足

watabe007さん、何度もすみません。

教わったコードで、無事にできたのですが、
ひとつだけ、行の高さが16行目までは完璧なのですが、
17行目以降が違う高さ(低く)なってしまいました。
度々で申し訳ないのですが、この改善策は
ありますでしょうか?

投稿日時 - 2012-08-23 14:38:42

ANo.2

Sub サンプル2()
  Dim wb As Workbook
  Dim myPath As String

  Set wb = Workbooks.Add(xlWBATWorksheet)
  With ThisWorkbook
    myPath = .Path
    .Sheets("オリジナル").Cells.Copy
  End With
  With wb
    .Sheets(1).Range("A1").PasteSpecial Paste:=xlValues '値貼り付け
    .Sheets(1).Range("A1").PasteSpecial Paste:=xlFormats '書式貼り付け
    .SaveAs Filename:=myPath & "\" & .Sheets(1).Range("L5").Value & ".xls"
    .Close
  End With
End Sub

投稿日時 - 2012-08-23 14:16:49

ANo.1

>この中の一つのシートだけを新たなBookにコピーして、
ThisWorkbook.Sheets("オリジナル") で宜しいですか?

>名前を付けて保存する際、Book名を、"L5"セルにある文字列にしたいと思い
ThisWorkbook.Sheets("オリジナル").Range("L5") で宜しいですか?
ThisWorkbookと同じPathに保存しました。

Sub サンプル()
  Dim myPath As String

  With ThisWorkbook
    myPath = .Path
    .Sheets("オリジナル").Copy 'コピー
  End With
  With ActiveWorkbook
    .SaveAs Filename:=myPath & "\" & Range("L5").Value & ".xlsx"
    .Close
  End With
End Sub

投稿日時 - 2012-08-23 11:30:02

補足

watabe007さん、ありがとうございます。

>ThisWorkbook.Sheets("オリジナル") で宜しいですか?
実際のシート名は違いますが、変更するので大丈夫?です。

>ThisWorkbook.Sheets("オリジナル").Range("L5") で宜しいですか?
>ThisWorkbookと同じPathに保存しました。

With ActiveWorkbook
    .SaveAs Filename:=myPath & "\" & Range("L5").Value & ".xlsx"
ここのことだと思うのですが、
Sheets(オリジナル)があるBookと同じフォルダの中に・・・
ということでしょうか?

あと、教えていただいたコードを試してみましたが、
コピー元のシートにマクロがあるので、
「次の機能はマクロなしのブックに保存できません」とでます。
これが出ないように、シート内のデータと書式だけを
コピーしたいのですが・・・

質問内容が不十分で申し訳ありません。
やりたい事を整理すると".xlsm"ファイルにある複数シートのうち
特定の一つのシートだけを新しいBookにコピーしたい。
この時、マクロは不要でデータと書式をコピーして、
名前を付けて保存。Book名をコピーしたBookの"L5"の
文字列をBook名にして保存したい。

再度お教えいただけないでしょうか?
よろしくお願いいたします。

投稿日時 - 2012-08-23 13:48:38

あなたにオススメの質問