いつもこちらの識者の皆様にはお世話になっております。
VBAのことで質問させてください。
ブックに、
"入力用","りんご","ばなな","みかん"
のシートがあります(シートは今後増える可能性があります)
このうち、"入力用"以外のシートに下記の処理をしたいのです。
1.1シートごとに新規でブックを作成し、データを値で貼り付ける。
2.ファイル名を"シート名" + mmdd形式でC:\aaa\に保存する(ex.C:\aaa\りんご0513.xls)
このときできれば、シートはコピーしてきた1つだけにするのが望ましいです。
作りかけのコードは下記です。
--------------------------------------------------------------
Sub test()
Dim objSh As Object
For Each objSh In ActiveWorkbook.Sheets
If objSh.Name <> "入力用" Then
objSh.Select
ThisWorkbook.ActiveSheet.Copy '関数が残っているので値で貼り付けたい
ActiveWorkbook.SaveAs Filename:="" 'コード不明
End If
Next
End Sub
--------------------------------------------------------------
分からない点は
1.ThisWorkbook.ActiveSheet.Copyで新規ブックにシートをコピーすることはできたのですが、
関数が残ってしまっているので、値で貼り付けたい。
2.シート名を取得して、ファイル名に反映する方法がわからない。
です。
どなたか、上記内容の場合どのようなコードが適しているか教えていただけませんでしょうか。
よろしくお願いいたします。
No.5ベストアンサー
- 回答日時:
回答No.3ですが、回答したマクロに誤記がありました。
ごめんなさい。その他下記に差し替えておこなってください。sub macro1r1()
dim w as worksheet
application.screenupdating = false
for each w in activeworkbook.worksheets
if w.name <> "入力用" then
on error goto errhandle
w.copy
on error goto 0
activesheet.usedrange.value = activesheet.usedrange.value
'下記一行誤記訂正。いわずもがなですが「正しい保存場所」にマクロを修正の事
activeworkbook.saveas filename:="C:\aaa\" & activesheet.name & format(date, "mmdd") & ".xls"
activeworkbook.close
retpos:
end if
next
application.screenupdating = true
exit sub
errhandle:
resume retpos
end sub
で。
>w.copyのところでエラー
単純なシートのコピーができない?
マクロのせいだとはあんまり考えにくいです。
>このうち、"入力用"以外のシートに下記の処理をしたいのです。
たとえば「非表示にしたシート」がブックに含まれているとかかもしれません。
この回答への補足
仰るとおりでした!
非表示にした"data"シートがありました。
正しくは
"入力用"と"data"シート以外のシートに下記の処理をしたいのです。ということになります・・・
No.4
- 回答日時:
'シート(指定されたものを除く)をコピーし、それぞれ名前を変更してブックで保存する
Option Explicit
Sub CopySheetsEachBooks()
'Const xPath0 = "d:\tmp\"
Const xPath0 ="C:\aaa\"
Const xExcept = "入力用"
Const xMode = False
Dim xSheet As Worksheet
Dim xPath As String
Dim xName As String
Dim xExtent As String
Dim xLast As Long
Dim nn As Long
Debug.Print vbNewLine & Now & " :Here We 5!"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xExtent = Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, "."))
If (xPath0 = Empty) Then
xPath = (ThisWorkbook.Path & "\")
Else
xPath = xPath0
End If
For Each xSheet In ThisWorkbook.Sheets
If (xSheet.Name <> xExcept) Then
'引数を省略すると、新規ブックが自動的に開いてシートだけがコピーされ、新規ブックがアクティブになる。当然、シートはソレだけ、、、
xSheet.Copy
ActiveSheet.UsedRange.Clear
Application.CutCopyMode = False
xSheet.UsedRange.Copy
With Range("A1")
' .PasteSpecial xlPasteValuesAndNumberFormats
'Excel2000はコォ~なっちゃう、、、
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
'ブック名を変更して保存
ActiveWorkbook.SaveAs Filename:=(xPath & xSheet.Name & Format(Date, "mmdd") & xExtent)
ActiveWorkbook.Close
End If
Next
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
No.3
- 回答日時:
シートをコピーし
値に直して(*)
名前を付けて保存する
*:書式のみ用意した空の雛形シートを用意できていれば、雛形シートのコピー&値転記の手順にできます。
*:実は「入力用」シートにリンクする数式だけを値化すればよいだけなら、別の考え方もありますが今回はとりあえずそれは考えない事に。
sub macro1()
dim w as worksheet
application.screenupdating = false
for each w in activeworkbook.worksheets
if w.name <> "入力用" then
w.copy
activesheet.usedrange.value = activesheet.usedrange.value
activeworkbook.saveas filename:="C*\aaa\" & activesheet.name & format(date, "mmdd") & ".xls"
activeworkbook.close
end if
next
application.screenupdating = true
end sub
この回答への補足
ありがとうございます。
このコードですとw.copyのところで
実行時エラー'1004':
'Copy'メソッドは失敗しました:'_Worksheet'オブジェクト
と出てしまいます。
何かこちらで指定してないことなどありましたでしょうか。
No.2
- 回答日時:
手抜きのサンプルです。
保存前に同名ファイルの有無位はチェックした方が良いかな。
Sub test()
Dim objSh As Object
For Each objSh In ActiveWorkbook.Sheets
If objSh.Name <> "入力用" Then
objSh.Copy
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues
Range("A1").Select
ActiveWorkbook.SaveAs Filename:="C:\aaa\" & objSh.Name & Format(Now(), "MMDD") & ".xls"
ActiveWindow.Close
End If
Next
End Sub
ありがとうございます。
↓の方の補足欄にも記入しておりますが、シートにはそれぞれ書式が設定されており、その書式は生かしたいのです。
説明不足で申し訳ありません。
No.1
- 回答日時:
こんにちは、こんな感じで。
Sub qa8085962()
Dim lSNW As Long
Dim wbN As Workbook
Dim wsC As Worksheet
Dim strFPath As String
Dim strD As String
lSNW = Application.SheetsInNewWorkbook '現在の新規bookのシート数を確認
strFPath = "C:\aaa" '保存先
strD = Format(Now(), "MMdd") '今日の日付をMMDDに
Application.SheetsInNewWorkbook = 1 '新規bookのシート数を1に変更
For Each wsC In ThisWorkbook.Worksheets
If wsC.Name <> "入力用" Then
Set wbN = Workbooks.Add
wsC.Range(wsC.Range("a1"), wsC.UsedRange.Address).Copy
wbN.Worksheets(1).Range("a1").PasteSpecial Paste:=xlPasteValues
wbN.SaveAs Filename:=strFPath & "\" & wsC.Name & strD & ".xls", FileFormat:=56 'FileFormatはexcel2007以降用
wbN.Close
Set wbN = Nothing
End If
Next
Application.SheetsInNewWorkbook = lSNW '新規bookのシート数を元に戻す
End Sub
この回答への補足
失礼しました。
私の説明が悪かったです。
シートにはそれぞれ書式が設定されており、その書式は生かしたいのです。
ThisWorkbook.ActiveSheet.Copy
で、新規ブックにペーストしてから、それを値に直す方法はありますでしょうか。
そして、excelのバージョンもお伝えしておりませんでした。
Excel2003になります。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
excelのマクロで該当処理できな...
-
【ExcelVBA】全シートのセルの...
-
別のシートから値を取得するとき
-
Excelマクロのエラーを解決した...
-
エクセル・マクロ シートの非...
-
実行時エラー1004「Select メソ...
-
特定の文字を含むシートだけマ...
-
実行時エラー'1004': WorkSheet...
-
Worksheet_Changeの内容を標準...
-
XL:BeforeDoubleClickが動かない
-
VBAで同じシート名のコピー時は...
-
ユーザーフォームに入力したデ...
-
ExcelのVBAのマクロで他のシー...
-
ExcelVBA シート名を複数セルか...
-
エクセルのマクロで対象ごとに...
-
Excel VBAでの全ワークシート...
-
シート名の一部を変更する方法...
-
EXCEL(VBA)でシート保護がかか...
-
エクセルのひとつのシートへの...
-
シート名一致すれば印刷、一致...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
特定の文字を含むシートだけマ...
-
excelのマクロで該当処理できな...
-
【ExcelVBA】全シートのセルの...
-
ユーザーフォームに入力したデ...
-
別のシートから値を取得するとき
-
ブック名、シート名を他のモジ...
-
実行時エラー'1004': WorkSheet...
-
Excelマクロのエラーを解決した...
-
XL:BeforeDoubleClickが動かない
-
シートが保護されている状態で...
-
エクセルのシート名変更で重複...
-
実行時エラー1004「Select メソ...
-
VBAで同じシート名のコピー時は...
-
エクセルで通し番号を入れてチ...
-
同じ作業を複数のシートに実行...
-
Excel VBA リンク先をシート...
-
ExcelのVBAのマクロで他のシー...
-
Vba UserformからExcelシートの...
-
【Excel VBA】Worksheets().Act...
-
VBA 存在しないシートを選...
おすすめ情報