Excel2010のVBAで起動時に連番表示&保存

このQ&Aのポイント
  • Excel2010でVBAを使用して起動時に連番を表示し、保存する方法について教えてください。
  • Windows7に変更した2台のパソコンでExcel2010を使用していますが、FileSearchが使えないことが分かりました。代わりにFileSystemObjectを使用する方法を教えてください。
  • 保存ボタンを押すと指定した場所に指定したセルの文字を拾ってファイル名を表示させることができません。エラーが発生してしまいます。どうすれば解決できるでしょうか?
回答を見る
  • ベストアンサー

Excel2010のVBAで起動時に連番表示&保存

【再掲載&追加情報です】 ずっとwindowsXP SP3を使用していたのですが(Excel2002 SP3もそのまま) 今回急遽社内のパソコンが2台(1台は自分のです)だけWindows7に変わりました。 その2台だけExcelも2002から2010に変わったのですが、使用しているファイルで記述してる FileSearchが使えないとあとから知りました。(泣) ネットで検索してFileSystemObjectを代わりに使用するというのを知りましたが 初心者の為理解が難しく・・・。 申し訳ありませんが記述の変更方法を教えていただけないでしょうか? (1)フォルダーは ”C:\指示\記入済” に出来たExcelファイルを保存してます (2)番号は指定フォルダ内のエクセルファイルをカウントしてその数+1を   U1のセルに表示させています。 (3)作成した保存ボタンで新見積書を保存する    但し、マクロコードとボタンを削除したものを保存する (4)新見積書の保存後はブック、エクセルともに終了する **************現在使用中データ************** --- Module1 ---- Public Const FPath = "C:\指示\記入済" 'xlsファイル検索 Sub Auto_Open() With Application.FileSearch .NewSearch .Filename = "*.xls" .FileType = msoFileTypeAllFiles .LookIn = FPath .SearchSubFolders = False .Execute Cells(1, 21).Value = .FoundFiles.Count + 1 Cells(1, 21).NumberFormat = "0000" End With End Sub --- Module2 ---- Sub ファイルに名前を付けて保存()  Dim 既定ファイル名 As String  Dim 保存ファイル名 As Variant 既定ファイル名 = FPath & "\" & Range("T1") & Format(Range("U1"), "0000") & Range("B1") & ".xls" 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名)   If 保存ファイル名 = False Then     MsgBox "保存は中止されました"     Exit Sub   End If  ActiveWorkbook.SaveCopyAs 保存ファイル名  Dim NewBook As Workbook  Set NewBook = Workbooks.Open(保存ファイル名)  Dim myVBA As Object  For Each myVBA In NewBook.VBProject.VBComponents    With myVBA     If .Type = 100 Then      .CodeModule.DeleteLines 1, .CodeModule.CountOfLines     Else      Application.VBE.activeVBProject.VBComponents.Remove myVBA     End If    End With  Next myVBA  NewBook.ActiveSheet.Shapes(1).Delete  NewBook.Close True '●●●  Set NewBook = Workbooks.Open(保存ファイル名)  NewBook.Close True '●●● 'ブックとエクセル終了  Application.Quit  ThisWorkbook.Close False End Sub ******************************************** 上記がExcel2002で問題なく動いている記述です。 最初Excel2010で起動してエラーが出たので検索したとき、てっきりFileSearchだけが問題 だと思っていたのですがもしかして他にもあったのでしょうか? --- Module1 ----は、先ほど質問したときに Public Const FPath = "C:\指示\記入済" 'xlsファイル検索 Sub Auto_Open() Dim tmp as String Dim i as Long tmp = Dir(FPath & "¥*.xls") Do While tmp <> "" i = i + 1 tmp = Dir() Loop Cells(1, 21).Value = i+1 Cells(1, 21).NumberFormat = "0000" End Sub に変更したら動くようになりました。 ただ、作成した保存ボタンを押すと指定した場所に指定したセルの文字を拾って ファイル名を表示させるまでマクロに登録(Module2)したのですが、 指定したフォルダは開いてるのですがファイル名が空欄のままです。 更にそれに手打ちでファイル名を打ち、保存すると 実行時エラー1004 プログラミングによるVisualBasicプロジェクトへのアクセスは信頼性に欠けます と表示されます・・・。 デバックを押すと For Each myVBA In NewBook.VBProject.VBComponents の部分が黄色くなってました>< 他に情報としては このファイルはxlt(テンプレート)にしています。 使用者たちにはファイル名を打たせないように上記のようにしました。 再度宜しくお願いします・・・。 何度もお手数をおかけしまして申し訳ありません。。。

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

  • ベストアンサー
  • MSZ006
  • ベストアンサー率38% (390/1011)
回答No.1

ひとつ目「保存ファイル名の欄が空欄のまま」については、自信がないのですが、モジュール2の 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名) の行を、 保存ファイル名 = Application.GetSaveAsFilename(InitialFileName:= 既定ファイル名) としてみてください。 ふたつ目、「プログラミングによる Visual Basic プロジェクトへのアクセスは信頼性に欠けます」については、エクセル2010自体のセキュリティの設定の問題だと思います。下記の設定をしてみてください。 「ファイル」タブを選択 画面左の「オプション」を選択 ダイアログ左の「セキュリティ センター」を選択 ダイアログ右の「セキュリティ センターの設定」ボタンを選択 ダイアログ左の「マクロの設定」 を選択 ダイアログ右の「VBA プロジェクト オブジェクト モデルへのアクセスを信頼する」のチェックボックスにチェックを入れる

k-marichan
質問者

お礼

お礼遅くなってすみません。(昨日は休みだったもので・・・) やってみましたら無事動きました! ありがとうございます>< 最後エラーが出ましたが原因はシート保護によるもので、 ファイル名を拾う部分のセルをロック解除してシート保護をしたら そのエラーもなくなり無事うごきました! ありがとうございましたっ!!

その他の回答 (1)

  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.2

こんにちは。お邪魔します。 ご提示の Sub ファイルに名前を付けて保存()、についてですが、 処理の内容としては、アクティブブックのコピーを取ってから、 VBAの記述と追加されているモジュールとシート上のShapeを削除する、 というものになっています。 わざわざVBIDE操作をする必要はないと思いますが、 VBAの記述を操作する、ということは、プログラムを書き換える、ということを意味します。 Excelを含む大抵のアプリケーションにおいて、容易に書換えが出来ない様に 保護する仕組みが予め用意してあります。 Excel VBAからVBAの内容を取得したり書き換えたりするには セキュリティレベルを大甘にして、 PCに紛れ込んでいるかも知れない善からぬプログラムに対しても無抵抗な状態 に設定を変更する必要があります。 ただ、セキュリティというのは、部分的に評価できるものではありませんから、 そうした無防備な状態であっても問題ないであろう環境もあろうかとは思います。 とはいえ、プログラムを書き換える、という意味においては、 決して他人に薦められるようなものではありませんし、 職場でそのようなプログラムを許可してもいいものか(私周辺では軒並み厳禁ですが)、 という議論も当然あることでしょう。 私個人としては、そういったコードは 他に方法がない非常に特殊な場合の、私的な用途に限って扱われるべきもの と考えています。 まぁでも人それぞれ事情はおありでしょうから、考えを押し付けるつもりもありません。 ただ、現実的な問題として、個々のPC環境について、 Excelのセキュリティ設定を変更しないと機能しない、というのでは、 ちょっと扱い難い、というか、できれば避けたい、のではないでしょうか。 以上のような考えを元に、平易な方法でも実現できることを 提案してみようと思います。  新規のブックを追加(予めシート数を合わせておく)  元となるブックのすべてのワークシートをループして   元となる各シートのセル範囲をコピーしたものを   新規ブックの対応するシートのセル範囲に貼り付ける   (シェープはコピーしない)  元となるブックのアクティブシートに対応する    シートを新規ブック側でアクティブにする  保存ファイル名を指定して.Save (閉じる?)  Excelを終了 というような処理内容です。 処理は少し増えますが、セキュリティ設定を変更する必要はありません。 >    但し、マクロコードとボタンを削除したものを保存する VBA(マクロ)とシェープ(ボタン)以外をコピーする、という風に解釈替えをしています。 (例外的に、グラフシートについては今回は無いものとして書いています。  あるならあるで、少し書き加えれば対応出来ますけれど) Application.GetSaveAsFilename の扱いは正しました。 > 実行時エラー1004 > プログラミングによるVisualBasicプロジェクトへのアクセスは信頼性に欠けます このエラーは起こりようがないように書きました。 xl2010では動作確認していますが、旧バージョンは未確認です。 何か問題があれば補足してみてください。 もしエラーが出る場合は、呼び出し元のボタンが、 フォームコントロールなのか、ActiveXコントロールなのか、によっても 対処が変わる場合があります。 なんだかんだ、標準的な、ベタな、処理しかしていませんが、 よりメンテし易い、質問した時にも答えられる人の多い、内容にはなっていると思います。 尚、Sub Auto_Open()、についてはこちらからは触れません。既に解決済と考えています。 ' ' --- Module2 ---- Sub ファイルに名前を付けて保存()   Dim 既定ファイル名 As String   Dim 保存ファイル名 As Variant   既定ファイル名 = FPath & "\" & Range("T1") & Format(Range("U1"), "0000") & Range("B1") & ".xls"   保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excelファイル,*.xls")   If 保存ファイル名 = False Then     MsgBox "保存は中止されました"     Exit Sub   End If   Dim NewBook As Workbook   Dim oWsht As Worksheet   Dim nShtInNew As Long   Dim bCopyObj As Boolean   Dim i As Long   With ActiveWorkbook     nShtInNew = Application.SheetsInNewWorkbook  '  ●シート数     Application.SheetsInNewWorkbook = .Worksheets.Count  '  ●シート数     Set NewBook = Workbooks.Add  '  新規ブック     Application.SheetsInNewWorkbook = nShtInNew  '  ●シート数     bCopyObj = Application.CopyObjectsWithCells  '  ●コピー_オブジェクト?     Application.CopyObjectsWithCells = False  '  ●コピー_オブジェクト?     For Each oWsht In .Worksheets       i = i + 1       oWsht.Cells.Copy NewBook.Worksheets(i).Cells(1)  '  シートからシート、セル範囲をコピペ     Next     Application.CopyObjectsWithCells = bCopyObj  '  ●コピー_オブジェクト?     NewBook.Sheets(.ActiveSheet.Index).Activate   End With   Application.DisplayAlerts = False   NewBook.SaveAs 保存ファイル名, xlExcel8  '  新規に作成したブックを保存ファイル名で保存   Application.DisplayAlerts = True '  MsgBox "保存しました"   NewBook.Close   ' ' ブックとエクセル終了   Application.Quit End Sub

k-marichan
質問者

お礼

マクロでマクロを消す行為は・・・以前このデータを作ったときにも 言われました>< マクロとボタン以外をコピーするという発想!思いつきませんでした! セキュリティを変えないですむというのはいいですねっ。 現在のファイルは回答No.1で教えていただいた方法で無事動くようになったので現状は無事仕事が進みますが、 この先を考えてこちらのコードも試してみたいと思います。 現在のシートは3シートに分かれていて(複写状態になっています【=シート1!S5】のように) ファイル名はシート1から拾うようにしている。 シート2、シート3はシート1で従業員が書いた部分が表示されるようにしています。 ボタンもシート1にあるだけです。 まずは書いていただいたものであとで試してみようと思います^^ ありがとうございましたっ!

関連するQ&A

  • Excel2010のVBAで起動時に連続番号を表示

    数年前にVBAで質問させていただきました。 ずっとwindowsXP SP3を使用していたのですが(Excel2002 SP3もそのまま) 今回急遽社内のパソコンが2台(1台は自分のです)だけWindows7に変わりました。 その2台だけExcelも2002から2010に変わったのですが、使用しているファイルで記述してる FileSearchが使えないとあとから知りました。(泣) ネットで検索してFileSystemObjectを代わりに使用するというのを知りましたが 初心者の為理解が難しく・・・。 申し訳ありませんが記述の変更方法を教えていただけないでしょうか? (1)フォルダーは ”C:\指示\記入済” に出来たExcelファイルを保存してます (2)番号は指定フォルダ内のエクセルファイルをカウントしてその数+1を   U1のセルに表示させています。 **************現在使用中データ************** Public Const FPath = "C:\指示\記入済" 'xlsファイル検索 Sub Auto_Open() With Application.FileSearch .NewSearch .Filename = "*.xls" .FileType = msoFileTypeAllFiles .LookIn = FPath .SearchSubFolders = False .Execute Cells(1, 21).Value = .FoundFiles.Count + 1 Cells(1, 21).NumberFormat = "0000" End With End Sub ******************************************** 上記がExcel2002で問題なく動いている記述です。 大変申し訳ありませんが、宜しくお願いします。

  • エクセルVBAを保存時に消したい

    はじめて質問させて頂きます。 エクセルのVBAを覚え始めたばかりの物ですが、 見積書式を作成し、見積番号をVBAでファイルOPEN時に自動挿入し 名前を付けて保存する時はその見積番号が保存する時にファイル名に なるようにVBAを作成しました。 見積番号の呼び出し方法は 指定フォルダにある(.xls)ファイルの数+1としています。 ここで質問なのですが現状だと保存したファイルにはVBAが存在するので そのファイルの修正をする時マクロの実行の有無を聞いてきます。 実行しないを選べば見積番号は変わらないのですが 間違えて実行してしまうとそのファイルの見積番号が変わってしまいます。。 回避方法として知り合いからアドインファイルにすれば?と言われて 保存形式をxlaにしたのですがエラーが出てしまいました>< Const FPath = "C:\指示書" Sub Auto_Open() 'xlsファイル検索 With Application.FileSearch .NewSearch .Filename = "*.xls" .FileType = msoFileTypeAllFiles .LookIn = FPath .SearchSubFolders = False .Execute Cells(1, 21).Value = .FoundFiles.Count + 1 Cells(1, 21).NumberFormat = "0000" End With End Sub したから4行目のCells(1, 21).Value = .FoundFiles.Count + 1 でエラーが出てしまうようで。。原因がわかりません。 何が原因なのでしょうか?><

  • excel2000のVBAを配布用に改造したい

    下記のコードを、多数のユーザーに配布するため、自動的にPERSONAL.XLSのModule 1に登録させられるようなコードを教えていただけるとありがたいです。よろしくお願いいたします。 ■お願いしたいこと (1)下記コード「passget」と「mailsheetopen」を自動的にPERSONAL.XLSのModule 1に追記するコードを教えてほしい (2)さらに「mailsheetopen」のコマンドをツールバー右下に自動的に表示させられるようにしたい Private sub passget() Dim TempObject As MSForms.DataObject Set TempObject = New MSForms.DataObject With TempObject .SetText "<<http://" & ActiveWorkbook.FullName & ">>" .PutInClipboard End With Set TempObject = Nothing End Sub '------------------------------------------------------------ Sub mailsheetopen() On Error Resume Next Call passget Dim target_dir As String Dim target_file As String Dim target_sheet As String target_dir = "C:\Users\new\Desktop" target_file = "rensyu.xls" target_sheet = "rensyu" 'ブックを開く Workbooks.Open Filename:=target_dir & "\" & target_file 'シートを指定 Sheets(target_sheet).Select 'セルを指定 Range("B6").PasteSpecial End Sub

  • (VBA)特定のシートのみを名前を付けて保存

    Excel2003です。 数シートあるうちの特定のシートのみを別のbookとして「名前を付けて保存」する下記のコードを書きました。一応うまく動くのですが、実はこの特定のシートには行の非表示部分があります。しかし、下記のコードではもちろん非表示部分も開かれた状態で保存がされますよね。 この非表示の状態で保存するにはどのようにすればよいのでしょうか? 【以下現在のコードです】 ------------------------------------------------ Sub 名前を付けて保存() '報告書を"名前を付けて保存" Sheets("報告書").Select Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant 既定ファイル名 = "報告書" 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls") If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Else With ThisWorkbook.ActiveSheet Workbooks.Add .Cells.Copy ActiveSheet.Range("A1") ActiveWorkbook.SaveAs 保存ファイル名, xlNormal ActiveWorkbook.Close False End With Sheets("報告書").Select Range("A1").Select MsgBox "報告書を作成しました。" End If End Sub ----------------------------------------------------

  • EXCEL2000でのVBAについて

    お世話になります。 EXCEL2000のVBで下記のことをしたいのですが、うまく出来ないところがあり対処方法を教えて頂きたいです。 (1)アクティブブックの名前を取得   (2)ブックのセルA1の値を取得 (3)保存ダイアログでA1の値をファイル名にし保存 (4)保存したファイルを閉じる (5)基のアクティブブックを再度開く 以上です。 今できていないのは(1)と(5)です。 基のアクティブブックの名前をプログラム上に直接入力する分には出来るのですが、 ファイル名が変更になった時に、いちいちVBを書き換えるのが面倒なだけです… コードを提示しますので、ご教授願えればと思います。 Sub 保存() Dim ファイル名 As String, フォルダ名 As Object, フォルダ選択 As Object, ファイル名2 As Workbook Set ファイル名2 = ActiveWorkbook ファイル名 = Range("A1").Value Set フォルダ選択 = CreateObject("Shell.Application") Set フォルダ名 = フォルダ選択.BrowseForFolder(0, "保存フォルダを選んでください", 1) ActiveWorkbook.SaveAs Filename:=フォルダ名.items.Item.Path & "\" & ファイル名 & ".xls" MsgBox ファイル名 & ".xls", vbOKOnly, フォルダ名 & "に保存しました" Workbooks.Open "C:\test\" & ファイル名2 Workbooks(ファイル名 & ".xls").Close End sub ファイル名の取得が間違っていると思うのですが、ネットなどで調べてみましたが、よくわかりませんでした。

  • excel VBA コピーファイルのマクロ削除

    下記3つの、プロシージャを組み合わせて、下記のやりたいことをやりたいのですが、うまくいきません。 どうかご教授の程よろしくお願いいたします。 excelは2000です。 ○やりたいこと 今現在開いているファイルの、コピーをデスクトップに保存して、その保存したブックのマクロ(標準モジュールと、コマンドボタン)を削除したい。 ○自分でやろうとすると コピーをデスクトップに保存すると、コピー元のファイルが勝手に閉じてしまい、コピー先のファイルのマクロを削除できない。 '■デスクトップにコピー保存 Sub copysave() Dim 場所 As String 場所 = CreateObject("WScript.Shell").SpecialFolders("Desktop") ActiveWorkbook.SaveAs Filename:=場所 & "\" & Format(Date, "yyyymmdd") & "○◆△.xls" End Sub '■標準モジュールの削除 Sub DelModule() Application.VBE.ActiveVBProject.VBComponents.Remove _   Application.VBE.ActiveVBProject.VBComponents("Module1") Application.VBE.ActiveVBProject.VBComponents.Remove _   Application.VBE.ActiveVBProject.VBComponents("Module2") End Sub '■CommandButtonの削除 Sub DelCommandButton() Dim c As Excel.OLEObject For Each c In Worksheets(1).OLEObjects   If TypeOf c.Object Is Msforms.CommandButton Then c.Delete End If Next End Sub

  • vbaマクロ 実行時エラー '91'について教えてください

    下記のマクロで、ファイル指定保存をする時に "実行時エラー91 オブジェクト変数またはWithブロック変数が設定されていません”がでます。 やりたいのは、選択したセルの1番目をファイル名として 保存をしたいのですが、うまくいきません。 どうしたらよいのでしょうか? Sub Macro1() Dim セル As Object Dim i As Long  i = 1  For Each セル In Selection   Worksheets("Sheet2").Cells(1, i).Value = セル     i = i + 1  Next ActiveWorkbook.SaveAs Filename:="D:\TEST\" & セル & ".xls" End Sub

  • Excel2003のVBAでエクセルファイルとして保存

    こんにちわ。 Excel2003のVBAで、シート1に採点用のフォーマットを作成し、採点ボタンを押したら別の場所(フォルダ)に別のファイル(.xls形式)として採点結果を保存したいと考えています。過去に似たような質問があったのでそれを参考にしたのですが、コードの意味がほとんど分かりません。下記のコードで実行したところ、エラーが出てしまいます。どこが悪いのか教えていただけないでしょうか? エラー箇所は BkName = OldWkbook.Sheets(StName1).Range("K1").Value です。”インデックスが有効範囲にありません”と表示されます。 例)   Dim FileName As String Dim FileExt As String Dim BkName As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "ko" ' Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName = OldWkbook.Sheets(StName1).Range("K1").Value FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If ' OldWkbook.Sheets(Array(StName1)).Copy Set NewWkbook = ActiveWorkbook 'シートの保護を解除 Worksheets("sheet1").Unprotect For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1 If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除 NewWkbook.Sheets(1).Shapes(wIx).Delete '←1ではなくwIxです End If Next NewWkbook.Sheets(1).Name = StName1 ' FileName = "D:\保存\計画\" & FileName ' If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If ' NewWkbook.Close savechanges:=False Application.DisplayAlerts = True End Sub

  • VBA 保存

    保存ボタンを作成してファイルに飛ぶように させていますが…どうしてもエラーになります! エラー表示内容> 実行時エラー1004 シートの名前を他のシート、Visual Basicで参照される オブジェクト ライブラリまたは ワークシートと同じ名前に変更することはできません。 下記は実際の記述です。 Private Sub 保存_Click() Dim FileName As String Dim FileExt As String Dim BkName As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "計画 グラフ" Const StName2 As String = "ケア一覧" ' Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName = OldWkbook.Sheets(StName1).Range("D1").Value FileName = BkName & Format(Now, "yyyy-mm-dd") & ".XLS" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If ' OldWkbook.Sheets(Array(StName1, StName2)).Copy Set NewWkbook = ActiveWorkbook For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count NewWkbook.Sheets(1).Shapes(1).Delete '←シート1のボタンを削除 Next NewWkbook.Sheets(1).Name = StName1 NewWkbook.Sheets(2).Name = StName2 ' FileName = "D:\看護計画保存\" & FileName ' If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If ' NewWkbook.Close savechanges:=False Application.DisplayAlerts = True End Sub

  • EXCEL2000とEXCEL2003のVBAについて

    現在、EXCEL2000で下記のコードを実行しています。 が、EXCEL2003で実行すると、 .UsedRange.Copy myb のコードが実行されているのにコピー出来ていません。 ファイルは開いていて、エラーは出ていないのです。 問題点わかる方教えていただけますか? Sub 日別データ読込() Dim rngsaki As Range Dim pathmacrobook As String Dim namebook As String Dim motobook As Workbook Dim myb As Variant Set rngsaki = Workbooks("残高集計用.xls").Worksheets(3).Range("a2") pathmacrobook = ThisWorkbook.Path & "\CSV読込データ12\" namebook = Dir(pathmacrobook & "*.xls") Do While Not namebook = "" Set motobook = Workbooks.Open(pathmacrobook & namebook) Set myb = Workbooks("残高集計用.xls").Worksheets(3).Range("A65536").End(xlUp) With motobook.Worksheets("Sheet1") .UsedRange.Copy myb End With motobook.Close False namebook = Dir() Loop MsgBox "完了しました" End Sub

専門家に質問してみよう