VBAでデータを自動保存する方法

このQ&Aのポイント
  • VBAを使用してデータを自動的に保存する方法について説明します。
  • 朝の8時にデータをコピーし、新しいブックとして保存する方法をVBAで実装する方法を紹介します。
  • 保存したいデータを指定し、定期的に実行することで、手動での保存手順を省略できます。
回答を見る
  • ベストアンサー

VBAについて

VBAについて質問です。 データをコピーして新規ブックとして名前(年、月、日)をつけて別のフォルダ(デスクトップ上のフォルダ)に毎朝8時に保存したいのですが、Cディスク内に直接保存されてしまいます。 コードは以下の通りです。 Sub 自動保存() With workbooks("サンプル.xism") Worksheets("Sheet3").Range("B6:B205").Value = .Worksheets("メインモニタ").Range("F13:F212").Value Worksheets("Sheet3").Range("D6:D205").Value = .Worksheets("メインモニタ").Range("K13:K212").Value Worksheets("Sheet3").Range("F6:F205").Value = .Worksheets("メインモニタ").Range("P13:P212").Value Worksheets("Sheet3").Range("H6:H205").Value = .Worksheets("メインモニタ").Range("U13:U212").Value End With Worksheets("Sheet3").Select Worksheets("Sheet3").Copy Application.DisplayAlerts = False With ActiveWorkbook.SaveAs "C:\サンプル2_" & Format(Date , "yyyymmdd") . Close End With Application.DisplayAlerts = True Application.OnTime DateValue(Date + 1) + TimeValue("8:00:00") , "自動保存" Worksheets("メインモニタ") . Activate End Sub ご教授宜しくお願いします。

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

  • ベストアンサー
  • heno-_-
  • ベストアンサー率100% (6/6)
回答No.2

質問者様は、ファイルのパスについての表記はご存じでしょうか? [ (ドライブ名): ]から始まり、ドライブ・フォルダ・ファイル名を [ \ ]で区切って表現します。 例えば、[ Cドライブ ]の直下にある[ AAA.txt ]と言うファイルの場合、 フルパスは[ C:\AAA.txt ]となります。 [ Dドライブ ]の直下の[ Test ]フォルダの中の[ BBB.txt ]ファイルなら、 フルパスは[ D:\Test\BBB.txt ]になります。 質問者様のコードでは、保存先( SaveAs関数の引数 )に [ C:\サンプル2_yyyymmdd ]としていますから、 Cドライブ直下に保存される訳です。 保存先をデスクトップにされたいのでしたら、 デスクトップのパスを指定しなくてはなりません。 デスクトップのパスはパソコンによって異なります。 Windows7をCドライブにインストールした例だと、 [ C:\Users\(ユーザ名)\Desktop ]になります。 ※(ユーザ名)は、ご自分のWindowsユーザ名です この場合、コードでは下記のようになります。 ActiveWorkbook.SaveAs "C:\Users\(ユーザ名)\Desktop\サンプル2_" & Format(Date , "yyyymmdd") . Close 拙い説明ですが、お分かりいただけたでしょうか?

yukichi_k2510
質問者

お礼

返事遅くなり申し訳ありません。 説明が分かりやすく大変勉強になりました。有難う御座います。 ファイル保存はお陰様でうまくいきました。 VBA初心者の為わからない事だらけです.... また何かわからない事が有ればご指導お願いします。

その他の回答 (1)

  • bin-chan
  • ベストアンサー率33% (1403/4213)
回答No.1

できあがるファイルは「サンプル2_20130219」みたいな名前?Cドライブ直下でしょ? ActiveWorkbook.SaveAs "C:\サンプル2_" & Format(Date , "yyyymmdd") と書いてあるから、Cドライブ直下に作ってるんじゃないの? Dドライブがあり、D\Backupフォルダでもあって、そこに保存したいなら ActiveWorkbook.SaveAs "D:\Backup\サンプル2_" & Format(Date , "yyyymmdd") じゃないの?

yukichi_k2510
質問者

お礼

返事が遅くなり申し訳ないです。保存はうまくいきました。 有難うございました。

関連するQ&A

  • Excel2007 VBAについて

    Excel2007 VBAについて質問です。 現在マクロでExcelデータを毎朝8時に保存フォルダに自動保存しているのですが、今回保存フォルダの中に年別フォルダ、月別フォルダを作成しその中に保存していきたいと思っています。 例 2013年フォルダの中に1月~12月のフォルダ 2013年2月25日の保存データは2013年フォルダ内の2月フォルダ内に保存。 ちなみに年度別フォルダは、2030年ぐらい迄作る予定です。 以下現在のマクロです。 Sub 自動保存() Dim 年 As String Dim 月 As String Dim 日 As String 年 = Year(Now()) 月 = Month(Now()) 日 = Day (Now()) With Workbooks (″サンプル.xlsm″) WorkSheets(″Sheet3″).Range(″B6:B205″).Value = Worksheets(″メインモニタ″).Range(″F13:F212″).Value End With Worksheets(″Sheet3″).Select Worksheets(″Sheet3″).Copy Application.DisplayAlerts = False Const mypath As String = ″C:¥保存データ¥″ With ActiveWorkbook.SaveAs″C:¥保存データ¥″_&年&″年″&月&″月″&日&″日″&″.xlsx″.Close End With Application.DisplayAlerts = True Application.Ontime DeteValue(Dete +1)+TimeValue(″8:00:00″),″自動保存″ Worksheets(″メインモニタ″).Activate End Sub すいませんがご指導願います。

  • VBAがうまく動きません。

    エクセルVBAで実行時は正確に動かないが、ステップインでは正常に作動するのはなぜですか? 入力シートに入力された情報を元にデータシートから抽出を行い、新規シートを開き、そこでリストにしたい情報のみを編集(不要なタイトル行などの削除)して、自動で貼り付けと名前の定義を行うマクロを作っています。 ステップイン[F8]や実行[F5]では正常に作動するのですが、実際に使用してみると、抽出データが貼り付けされていない状態(セルは空白)となりますが、名前の定義は抽出データと同じ行まで定義されているので、貼り付けのみ上手くいっていないように思われます。 下記が作成したコードです。情報が足りないようでしたら、申し訳ありません。 お手上げ状態となっていますので、お力添えいただけると幸いです。 Dim syurui as String Dim suuryou as Integer Dim target as Range Private Sub Worksheet_Change(ByVal target As Range) If Intersect(target, Range("D7")) Is Nothing Then Exit Sub Else Call 抜出 End If End Sub Sub 抜出() Worksheets("データ").Activate ’後に出てくる名前初期化でエラーを防ぐため仮定義 ActiveWorkbook.Names.Add Name:="番号", _ RefersTo:=Worksheets("データ").Range("K2") syurui = Worksheets("入力").Range("D9").Value Worksheets("データ").Select Set target = Worksheets("データ").Range("M2") With Worksheets("データ").Range("D1") .AutoFilter field:=4, Criteria1:=syurui .CurrentRegion.SpecialCells(xlVisible).Copy With Worksheets.Add .Paste ’不要な行を削除 .Rows(1).Delete .Range("A:D").Delete .Range("B:F").Delete ’抽出した情報を貼り付け&新規シート削除 .UsedRange.Copy target Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True End With .AutoFilter End With ’抽出データの最終行を調べる suuryou = Worksheets("データ").Cells(65536, "M").End(xlUp).Row If suuryou = 1 Then Worksheets("入力").Activate Exit Sub Else Range("番号").Name.Delete ActiveWorkbook.Names.Add Name:="番号", _ RefersTo:=Worksheets(”データ").Range("M2:M" & suuryou) End If Worksheets("入力").Activate End Sub

  • エクセル VBAについて。

    Private Sub ComboBox2_Change() On Error Resume Next With Me.ComboBox2 If .ListCount < 0 Then Exit Sub If .Value = "" Then Exit Sub Me.Range("K45").Value = _ Worksheets("マスタ").Range(.List(.ListIndex, 1)).Offset(0, 2).Value Me.Range("K48").Value = _ Worksheets("マスタ").Range(.List(.ListIndex, 1)).Offset(0, 4).Value End With End Sub これをマスタのU列とW列を表示したい場合、どこを変えれば良いのでしょうか? 今はD列とF列が表示されております。

  • エクセルのフォームのVBAについて

    VBAがまったくわからないのに参考書を見て高度な事に挑戦しています フォームは作れてフォームをクリックやら入力やらして作ったOKボタンを押すと シート2のA1B1C1‥の列に入力文字だけが羅列されます。 しかし次にやろうとするとA2B2C2‥と下に行かず又A1B1C1‥の列の文字が変更になり続きません。何がいけないのでしょうか? Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row .Range("A" & LastRow).Value = Worksheets("sheet1").Range("A5").Value .Range("B" & LastRow).Value = Worksheets("sheet1").Range("A7").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("A8").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("A10").Value End With End Sub と参考書とおりいれたのですが‥。教えて下さい。

  • VBAでVlookup関数を組もうとしていますがエラーが出ます。VBAに詳しい方、教えてください

    VBAでvlookup関数を下のように組みましたが、(1)でエラーが出ます。VBAに詳しい方、教えてください。 Sub VLLOKUPによる表の検索4() Dim mykensakuchi Dim mykensakuhan Dim gyo As Integer (1) mykensakuchi = Worksheets("sheet1").Range("a" & gyo).Value mykensakuhan = Worksheets("sheet2").Range("b2:e9") saikagyo = Worksheets("sheet1").Range("a" & Rows.Count).End(xlUp).Row gyo = 2 For gyo = saikagyo To 1 Step -1 With Application.WorksheetFunction Range("b:gyo").Value = .VLookup(mykensakuchi, mykensakuhan, 2, False) End With Next End Sub

  • 他のブックでマクロを実行するには?

    以下のマクロを実行すると同一ブック内の他のシートに入力 されますが、これを他のブックのシートに入力されるように するには、具体的にどのようにすればいいのでしょうか? ご教授ください。 ---------------------------------------------------------------- Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1 .Range("B" & LastRow).Value = Worksheets("sheet1").Range("B1").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("B3").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("B5").Value .Range("E" & LastRow).Value = Worksheets("sheet1").Range("B7").Value .Range("F" & LastRow).Value = Worksheets("sheet1").Range("B9").Value .Range("G" & LastRow).Value = Worksheets("sheet1").Range("B11").Value End With End Sub

  • Excel VBA 構文をすっきりさせたい

    いつもお世話になっています。 次のような構文を使って、データを別シートに転送するVBAを作成しました。 転送するデータが多い場合、構文が延々続くことになります。 もっとすっきりと記述する方法がありましたらぜひ教えてください。 お力添え、よろしくお願いします。 Sub データ() With ActiveSheet Dim last last = ActiveSheet.Range("b" & Rows.Count).End(xlUp).Row + 1 .Range("b" & last).Value = Worksheets(2).Range("b2").Value .Range("c" & last).Value = Worksheets(2).Range("c2").Value .Range("d" & last).Value = Worksheets(2).Range("d2").Value     以下同様に続く・・・・ End With End Sub

  • Excel VBAについて

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub Application.Goto Worksheets("人件費").Range("A1") Worksheets("人件費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub Application.Goto Worksheets("外注費").Range("A1") Worksheets("外注費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub 上の指令はFの列をダブルクリックすると人件費のシートが開いてAある値を人件費の新しいセルのAに代入する指令ですが それをG列ダブルクリックで外注費シートに同じようにやろうと思いましたが出来ません。 たぶん根本的に書き方が間違っているのかと思われますが、ご指導のほどお願いします。

  • 【VBA】 超初心者です 複数のシートに転記したい

    Sub べんきょう() Worksheets(Array(1, 3)).Select Range("A1").value = 20 End Sub もしくは Sub べんきょう() Worksheets("sheet1").Select Worksheets("sheet3").Select False Range("A1").value = 20 End Sub でやってもsheet1にしか転記されないんです!! ご指導よろしくお願いします!

  • エクセルVBAについて

    エクセルVBA初心者で、勉強中の者です。 添付画像のような時間のグラフのようなものを作りたいと思っています。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub 時間グラフ作成() If Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = CDate("9:05") Then Worksheets("(2)(2)(2)(2)").Range("I2").Select  With Selection.Interior   .ColorIndex = 8   .Pattern = xlSolid  End With Elseif Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = CDate("9:10") Then Worksheets("(2)(2)(2)(2)").Range("J2").Select  With Selection.Interior   .ColorIndex = 8   .Pattern = xlSolid  End With  ・  ・   ・ End If End Sub 'それから、終了の時間を入れて、開始から終了までの間を塗りつぶす。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 以上のように作成しようと考えていましたが、いざやろうとすると 1行に対してあまりにも膨大な記述をしなくてはならないことに 気がつきました(一月分ともなると恐ろしいです・・・)・・・。 もっと効率的な方法はあるものでしょうか? よろしくお願いいたします。