VBAでシートの保護 -初めまして。私はWindowsXP、Excel2-

エクセル　VBA　シート保存ボタン

Sheet上にボタンを作成ボタンを押すと保存するようにしています！以前ここでSheet2枚をコピー出来るような記述教えてもらったのですが・・ 1枚ならどう変化して良いか・・記述を書きましたが何処が違うか教えて下さい！ Private Sub CommandButton1_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 = "ko" 　　　　' 　　Application.DisplayAlerts = False 　　Set OldWkbook = ActiveWorkbook 　　' 　　'ファイル名を取得　　BkName = OldWkbook.Sheets(StName1).Range("A1").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 　　For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count 　　　　NewWkbook.Sheets(1).Shapes(wIx).Delete　　　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　保存

保存ボタンを作成してファイルに飛ぶようにさせていますが…どうしてもエラーになります！エラー表示内容＞実行時エラー１００４シートの名前を他のシート、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

Excel2003VBAでファイルをコピーして指定場所に保存

こんにちわ。私は下記のコードで保存場所をＣドライブに指定しているのですが、これを保存先が選べるようにするのはどうすれば良いですか？ Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName1 = OldWkbook.Sheets(StName1).Range("E1").Value BkName2 = OldWkbook.Sheets(StName1).Range("E2").Value BkName3 = OldWkbook.Sheets(StName1).Range("E3").Value FileName = BkName1 & Format(".") & Format("試験結果") & Format(".") & BkName2 & Format(".") & BkName3 & ".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 'シートの保護を解除 Worksheets("Sheet1").Unprotect Worksheets("Sheet2").Unprotect Worksheets("Sheet3").Unprotect OldWkbook.Sheets(Array(StName1, StName2, StName3, StName4, StName5)).copy Set NewWkbook = ActiveWorkbook 'ボタンを削除 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 End If Next NewWkbook.Sheets(1).Name = StName1 'コピー先シートの保護 Sheets(1).Protect Sheets(2).Protect Sheets(3).Protect Sheets(4).Protect Sheets(5).Protect FileName = "C:\" & FileName If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 'シートの保護 Worksheets("Sheet1").Protect Worksheets("Sheet2").Protect Worksheets("Sheet3").Protect Exit Sub '##指定ファイル置き換え保存 End If NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If NewWkbook.Close savechanges:=False Application.DisplayAlerts = True 'シートの保護 Worksheets("Sheet1").Protect Worksheets("Sheet2").Protect Worksheets("Sheet3").Protect 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

ＶＢＡの記述で、あるシートを別ファイルにした場合

エクセル2002で、商品を管理しています。１列目に品番をいれると、２列目に品名が表示するようにし、新規の品番は品名を入れると、追加登録されるようにＶＢＡを組みました。今度、このシート"商品"を別ファイル(商品.xls)にしたいと思うのですが、どうしても、やり方が分かりません。よろしくお願いします。 Public Sub Worksheet_Change(ByVal Target As Excel.Range) Dim 品番 As String Dim 品名 As String Dim i As Long With Target If .Column = 1 Then 品番 = .Text For i = 1 To 65536 If Sheets("商品").Cells(i, 1) = "" Then ActiveSheet.Cells(.Row, 2) = "" Exit For ElseIf 品番 = Sheets("商品").Cells(i, 1) Then ActiveSheet.Cells(.Row, 2) = Sheets("商品").Cells(i, 2) Exit For End If Next i End If If .Column = 2 Then 品名 = .Text 品番 = ActiveSheet.Cells(.Row, 1) If 品名 = "" Or 品番 = "" Then Else For i = 1 To 65536 If Sheets("商品").Cells(i, 1) = "" Then Sheets("商品").Cells(i, 1) = 品番 Sheets("商品").Cells(i, 2) = 品名 Exit For ElseIf 品番 = Sheets("商品").Cells(i, 1) Then Exit For End If Next i End If End If End With End Sub

エクセル　シートのみ　保存

過去の質問も参照しましたが当てはまる物が無くて質問しました！シート上にボタンを作成してクリックするとそのシートのみ指定するファイルにコピーさせたいです！下記の部分で何処を変化させればよいのでしょうか？ (1)～(2)の部分で困っています。 Private Sub CommandButton1_Click() Dim FileName As String Dim FileExt As String ’(1)の質問！○＝の部分をSheets（セルのA1の値をファイル名に入れたいです） FileName = "○"& 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 '==== FileName = "D:\保存\ケア\計画\" & FileName If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。上書きしますか?", vbOKCancel, "上書きの確認") = vbCancel Then '##保存せずに終了 Exit Sub ElseIf ThisSheets.FullName = FileName Then '##現在開いているファイルと同じなら上書き保存 ThisSheets.Save Else '##指定ファイルを削除した後保存 Kill FileName ThisSheets.SaveCopyAs FileName:=FileName End If Else '##ファイルを新規保存 ThisSheets.SaveCopyAs FileName:=FileName End If ThisSheets.Saved = True End Sub (2)ThisSheets＆指定してもう一つだけ　保存先にコピーしたいです！つまり　２つのSheetのみ保存させたいのですが・・　ここからどのようにしたら良いのか　お願いします！教えて下さい。　

VBAで、定数式が必要ですのエラー対応

指定のファイルをフォルダAからフォルダBへ移動させるというvbaを見つけたのですが、サンプルの表記は「"C:\Data\A"」と直接場所をしていしたものなので、参照するフォルダ場所として、セルC1を参照させようと、「Range("C1")」と書き直したところ、「コンパイルエラー：定数式が必要です」とエラーになってしまいます。どの様に書き直せばよいのでしょうか？どなたかご存じでしたら、ぜひお教え下さい。よろしくお願いします。エクセル2010を使用しています。 Sub CheckAndMoveFiles() Const FolderA = Range("C1")　'エラー発生 'Const FolderA = "C:\Data\A"　サンプルの表記　　Const FolderB = "C:\Data\B" Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim ws As Worksheet Set ws = ActiveSheet Dim lastRow As Long lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row Dim r As Long Dim fileName As String For r = 1 To lastRow If ws.Cells(r, "A").Value <> "" Then ' fileName = ws.Cells(r, "A").Value & ".xls" fileName = ws.Cells(r, "A").Value If fso.FileExists(FolderA & "\" & fileName) = True Then fso.moveFile FolderA & "\" & fileName, FolderB & "\" & fileName End If End If Next End Sub

エクセルVBAでのエラー

おはようございます。昨日ここでいろいろ教えていただき、300のエクセルファイルから特定の範囲のデータ抽出方法を書いてみたのですが、セルが多すぎて実行できません、というエラーがでてしまいます。これはどのように解消すればよろしいのでしょうか？ Sub Test() Dim FPath1 As String, FPath2 As String Dim FName As String, myBook As String Const startROW As Long = 14, lastROW As Long = 20 Const startCOL As Long = 8, lastCOL As Long = 10 Const shtNAME As String = "sheet1" Application.ScreenUpdating = False FPath1 = "D:\MR5567\" FPath2 = "D:\New Microsoft Excel Worksheet\" Workbooks.Add myBook = ActiveWorkbook.Name FName = Dir$(FPath1 & "*.xls") Do While FName <> "" Workbooks.Open Filename:=FPath1 & FName ActiveWorkbook.Sheets.Select Sheets(1).Activate Sheets.Copy After:=Workbooks(myBook).Sheets(Sheets.Count) Workbooks(FName).Activate Application.DisplayAlerts = False ActiveWorkbook.Close FName = Dir$ Loop ActiveWorkbook.SaveAs Filename:=FPath2 & "Renketsu.xls", FileFormat:=xlNormal ActiveWorkbook.Close Application.ScreenUpdating = True End Sub

エクセル、ワークシートが保護されているかどうかを判断するVBAは？

以下のように書いてもダメでした。どう直せばよいでしょうか？ Sub TEST2() Dim n As Integer n = ThisWorkbook.Worksheets.Count For i = 1 To n If Worksheets(i).Protect = False Then MsgBox Worksheets(i).Name End If Next End Sub

VBAを実行するとエクセルが落ちる

同一フォルダ内にあるCSVデータを一つのエクセルにワークブックにまとめるため CSVデータを開いて、各シートに値を貼り付けるVBAを作成しましたデバックモードで1行毎に実行するとエクセルが落ちることはありませんが普通に実行するとエクセルが閉じてしまいます原因が分からないためご指摘いただけると幸いです Win7のOffice2013です。 Sub contents() Sheets("01").Select Sheets("01").Cells.Select Selection.ClearContents Dim ShA As Worksheet Dim FileA As String Set ShA = ThisWorkbook.Sheets("01") ChDir "C:\Users\Public\Documents" FileA = "C:\Users\Public\Documents\01.csv" If FileA <> "False" Then Workbooks.OpenText Filename:=FileA, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, Comma:=True ActiveSheet.Cells.CurrentRegion.Copy Destination:=ShA.Range("A1") ActiveWorkbook.Close False End If Set ShA = Nothing Sheets("02").Select Sheets("02").Cells.Select Selection.ClearContents Dim ShB As Worksheet Dim FileB As String Set ShB = ThisWorkbook.Sheets("02") ChDir "C:\Users\Public\Documents" FileB = "C:\Users\Public\Documents\02.csv" If FileB <> "False" Then Workbooks.OpenText Filename:=FileB, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, Comma:=True ActiveSheet.Cells.CurrentRegion.Copy Destination:=ShB.Range("A1") ActiveWorkbook.Close False End If Set ShB = Nothing Sheets("03").Select Sheets("03").Cells.Select Selection.ClearContents Dim ShC As Worksheet Dim FileC As String Set ShC = ThisWorkbook.Sheets("03") ChDir "C:\Users\Public\Documents" FileC = "C:\Users\Public\Documents\03.csv" If FileC <> "False" Then Workbooks.OpenText Filename:=FileC, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, Comma:=True ActiveSheet.Cells.CurrentRegion.Copy Destination:=ShC.Range("A1") ActiveWorkbook.Close False End If Set ShC = Nothing End Sub

Excelのブック間の串刺し計算について

Excelのブック間の串刺し計算について VBA超初心者です。同じフォルダ内にファイルがいくつかあり、同じ形式で、sheet1のB4のセルに計があったとして、それをブック間で串刺し集計したいのですが、うまくいきません。どこが悪いのかもわからず、困り果ててます。ご指導お願いします。 Sub BookShuukei() Dim FileName As String Dim Total As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean FileName = Dir("*.xls") Application.ScreenUpdating = False Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Total = Total + Workbooks(FileName).Sheets(1).Range("B4").Value If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.ScreenUpdating = True MsgBox (Total) End Sub

ＥＸＣＥＬ　ＶＢＡ　データのある範囲の特定が悪い？　　

アンケート調査票を簡単につくために、下のようなマクロを教えていただいたのですが、もとデータ項目の参照範囲がセルのＢ５より上にあるもの（空白の場合も）も項目としてしまっているようなので、どこを手直しすればいいのか、すみませんが教えてください。 Sub test() '定数の設定 Const strInputSheet As String = "Sheet1" Const lngInputRow As Long = 5 Const lngInputCol As Long = 2 Const strOutputSheet As String = "Sheet2" Const lngOutputCol As Long = 3 Const lngOutputRow As Long = 4 Const strMessageA As String = " は " Const strMessageB As String = " に対してどの位影響があると思いますか？" '定義 Dim lngMaxRow As Long Dim lngCountA As Long Dim lngCountB As Long Dim strA As String Dim strB As String Dim lngRow As Long '項目数を把握 Sheets(strInputSheet).Select Cells(ActiveSheet.Rows.Count, lngInputCol).Select Selection.End(xlUp).Select lngMaxRow = Selection.Row 'Ｂ列のデータ最終行を取得 lngRow = lngOutputRow '出力開始行の設定 '項目Aをなめる For lngCountA = lngInputRow To lngMaxRow 　strA = Cells(lngCountA, lngInputCol).Value '項目Aの取得　'項目Bをなめる　For lngCountB = 1 To lngMaxRow 　　If lngCountA <> lngCountB Then '項目Aと項目Bが同じときはここは処理しない　　　strB = Cells(lngCountB, lngInputCol).Value '項目Bを取得　　　Sheets(strOutputSheet).Cells(lngRow, lngOutputCol).Value = strA & strMessageA & strB & strMessageB '文字列を結合　　　lngRow = lngRow + 1 '改行する　　End If 　Next lngCountB Next lngCountA End Sub

エクセル　ＶＢＡ　シートの選択　

windows XP でエクセル２０００を使っています。 Sub aaa() Sheets("Sheet1").Select Dim a As String a = Cells(2, 4) Sheets(a).Select Range("A1").Select End Sub というマクロだと　セルに入っている値のシート名を探してくれます。ですが Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Intersect(Target, Range("B11:b683")) Is Nothing Then Exit Sub Worksheets("Sheet1").Range("C2").Value = Target.Value Dim b As String b = Range("C2).value （←ここをcellsにしてもダメ） Sheets(b).Select Range("A1").Select End Sub これだとsheets(b)を選びません。Sheets(b).Selectのところが黄色くなります。何処が間違えているのでしょうか。全くの素人ですが、仕事で必要に迫られています。わかりやすく回答・解説くれると助かります。

VBAでのシート選択について

いつもお世話になります。 VBA初心者で、基本的な質問をしているかもしれませんが、どうかお付き合いください；；たとえば、以下のようなコードがあったとします。例） Function Sample() dim x As Integer dim y As Integer x=10 y=100 If x > sheets("シート2").Range("A1") AND y < sheets("シート2").Range("A1") Then 処理 End If End Function 例えば上記のコードのようなものがあったとして、シート名を省いて文字数を減らす方法はあるでしょうか？ 1つのFunction内では「このシート」しか参照しないというような指定が出来ると、 If x > Range("A1") AND y < Range("A1") Then というように簡単にできますよね？他のFunctionでは、シートの指定はさせたくないので、 End Functionの手前で、「シート指定終了」というのを記述できればベストなのですが…。どうかよろしくお願いいたします。

マクロ　シートの保護

下記のマクロにおいて、A列以外のセルに文字なり数字なりを書くと、シートの保護が解除されてしまいます。また、保護が解除されている状態でA列に20091010と入力してマクロを実行させるとシートが保護されます。ずーっと保護された状態を続けるようにするにはどのようにすればよいですか？ Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim r As Range Dim flg As Long flg = 0 If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect flg = 1 End If If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub 'A列のみを対象　最初につなげるところ For Each r In Target Dim a As Long Dim b As String With r If Not .NumberFormatLocal = "ge.m.d" Or .Value = "" Then .NumberFormatLocal = "G/標準" 'セルの書式設定がH00.m.d形式だったら標準に戻す 'セルが　数字　　　　且　　　　　　整数　　　　且　　101以上　　且　　　　991231以下　の場合 If IsNumeric(.Value) And Int(.Value) = .Value And .Value >= 19010101 And .Value <= 20991231 Then b = Left(.Value, 4) & "/" & Mid(.Value, 5, 2) & "/" & Right(.Value, 2) If IsDate(b) Then 'もしbがDateの形なら .Value = CDate(b) 'データ型を日付にする 'ここにつなげる。　変数はtmpからbに直す .NumberFormatLocal = "ggg" & _ IIf(Format(b, "e") > 9, "e年", "_0e年") & _ IIf(Month(b) > 9, "m月", "_1m月") & _ IIf(Day(b) > 9, "d日", "_1d日") If ActiveSheet.UnprotectContents = True Then ActiveSheet.Protect flg = 1 End If End If End If End With Next If flg = 1 Then ActiveSheet.Protect End Sub

エクセルVBA　ブック間のコピー

選択したテキストファイルをエクセルで開いたコピーし、もう一つ開いたエクセルファイルにペーストするというマクロをVBAで作成していますが、つまずいてしまいました。 ----------------------------------- Dim wb1 As String Dim wb2 As String Sub Opentxt() wb1 = Application.GetOpenFilename("テキストファイル,*.txt") If wb1 <> "False" Then Workbooks.OpenText Filename:=wb1, DataType:=xlDelimited, comma:=True End If End Sub Sub Copy() Dim LastRow As Long wb2 = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") If wb2 <> "False" Then Workbooks.Open wb2 LastRow = wb2.Sheets("一覧表").Range("A" & Rows.Count). End(xlUp).Row wb2.Sheets("一覧表").Range("A5:A" & lastRow).Copy _ wb1.Sheets("Sheet1).Range("B33") End If End Sub ----------------------------------- Opentxtの方は問題ないですが、Copyの方を実行すると wb1とwb2で引っかかって「コンパイルエラー/ 修飾子が不正です」と表示されて、エラーになってしまいます。この場合変数の型などがおかしいのでしょうか？ excel2007を使用しています。よろしくお願いします。

フォルダ内の全てのファイル開く時間短縮の方法

Excelのマクロを使ってフォルダ内の全てのファイルを開く以下のコードを利用しているのですが（教えてgoo！で教えて頂いたコードです）、ファイル数が１０個くらいあるため全部開くのに１分くらいかかってしまいます。もっと時間を短縮することはできませんでしょうか？ Sub OpenAllBook() 　　Dim FileName As String 　　Dim OpenedBook As Workbook 　　Dim IsBookOpen As Boolean 　　ChDir ("フォルダ名") 　　FileName = Dir("*.xls") 　　Do While FileName <> "" 　　　If FileName <> ThisWorkbook.Name Then 　　　　IsBookOpen = False 　　　　For Each OpenedBook In Workbooks 　　　　　If OpenedBook.Name = FileName Then 　　　　　　IsBookOpen = True 　　　　　　Exit For 　　　　　End If 　　　　Next 　　　　If IsBookOpen = False Then 　　　　　Workbooks.Open (FileName) 　　　　End If 　　　End If 　　　FileName = Dir() 　　Loop End Sub

Excel VBA で特定のシートのみ除外

ＶＢＡで以下のような、ブック内の全シートから特定の文字列が入った行のみを新しくシート作成して一覧化するマクロを組みました。検索する時に保護解除するなど別の作業もあるため無駄に長くなっております。 Sub 検索() Dim Sh As Worksheet, Rng As Range Dim StrFind As String, Res As String Dim Rw As Long, R As Long Dim N As Integer Const OutShName = "検索結果" StrFind = InputBox("検索する文字列を入力してください。" & " 　　検索する文字列は正確に。", "検索文字列") If StrFind = vbNullString Then Exit Sub Dim Ws As Worksheet Application.ScreenUpdating = False For Each Ws In Worksheets Ws.Unprotect Password:=908118 Next Application.ScreenUpdating = True Application.ScreenUpdating = False UserForm1.Show vbModeless UserForm1.Repaint For N = 1 To Worksheets.Count If Worksheets(N).Name = OutShName Then Set Sh = Worksheets(N) Sh.Move after:=Worksheets(Worksheets.Count) Sh.Cells.ClearContents Exit For End If Next N If N > Worksheets.Count Then Set Sh = Sheets.Add(after:=Worksheets(Worksheets.Count)) Sh.Name = OutShName End If Worksheets(1).Rows(1).Copy Sh.Rows(1) R = 2 For N = 1 To Worksheets.Count - 1 With Worksheets(N).UsedRange For Rw = 1 To .Rows.Count Set Rng = .Cells(Rw, 1).Resize(, .Columns.Count).Find(StrFind) If Not Rng Is Nothing Then Rng.EntireRow.Copy Sh.Rows(R) R = R + 1 End If Next Rw End With Next N Unload UserForm1 ResultMsg: If R < 3 Then Res = "「" & StrFind & "」は、見つかりません。" For Each Ws In Worksheets Ws.Protect Password:=908118 Next Sheets("TOP").Select Else Columns("A:A").ColumnWidth = 20 Columns("C:C").ColumnWidth = 13 Rows("1:1").RowHeight = 30 Sheets("12月").Select Rows("1:1").Select Selection.Copy Sheets("検索").Select Range("A1").Select Application.ScreenUpdating = True Res = "「" & StrFind & "」は、" & R - 2 & " 件見つかりました。 " & _ String(2, vbLf) & Sh.Name & " に抽出しました。" Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.Font.Bold = False Selection.Font.Bold = True End If MsgBox Res, vbInformation, "検索完了" Set Rng = Nothing End Sub Excel2003を使用してます。シートは30枚程あり、複雑な計算式等が入っています。この時、特定のシート（例:"月別データ")のみを除外したいのですが、いまいちわかっておりません。稚拙な質問かと思いますがご指導していただきたく思います。

vba　ファイルの移動について

フォルダAの中にあるたくさんのpdfファイルの中から、ファイル名の頭文字３つがE列に記載した「aaa」だったらフォルダBに移動させるという内容にしたいです。ネット検索などで、近いものを作成しましたが（下に貼り付け）、下から４行目、「fso.moveFile FolderA & "\" & fileName, FolderB & "\" & fileName」で「実行時エラー'53'　　ファイルが見つかりません。」　とエラーが出てしまいます。どの様に書き直せばよいのでしょうか？どなたかご存じでしたら、ぜひお教え下さい。よろしくお願いします。エクセル2010を使用しています。 Sub CheckAndMoveFiles() Dim FolderA As String Dim FolderB As String FolderA = Range("D1").Value FolderB = Range("B2").Value Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim ws As Worksheet Set ws = ActiveSheet Dim lastRow As Long lastRow = ws.Range("E" & Rows.Count).End(xlUp).Row Dim r As Long Dim fileName As String For r = 1 To lastRow If ws.Cells(r, "E").Value <> "" Then fileName = ws.Cells(r, "E").Value dFileName = Dir(FolderA & "\" & Left(fileName, 3) & "*.pdf") Do While dFileName <> "" dFileName = Dir() Loop fso.moveFile FolderA & "\" & fileName, FolderB & "\" & fileName　'ここでストップ End If Next End Sub

VBA中の”シート名”を”アクティブシート”に変更

いつもお世話になっております。非常に初歩的な質問なのですが、下記の2つのVBA中のシート名をアクティブシートに変更したいのですが、 sheetName = ActiveSheet.Name で試行錯誤するもうまくいきません。実際のコードは下記の通りです。これらのシート名”申請書”をアクティブシートに変更したいのです。このコードは過去にここで教えて頂いたコードで出来ればこれを修正したいので宜しくお願いします。１．Sub 申請書登録() Dim NewBookName As String With ThisWorkbook.Sheets("申請書") Windows("1.新規・変更登録申請書(原紙)･ﾘｽﾄ②T用.xlsm").Activate For i = 5 To Sheets("規格登録・変更ﾘｽﾄ").Range("A1048576").End(xlUp).Row + 1 If Sheets("規格登録・変更ﾘｽﾄ").Range("B" & i).Value = "" Then With Sheets("規格登録・変更ﾘｽﾄ") .Range("A" & i).Value = Sheets("申請書").Range("E3").Value .Range("B" & i).Value = Sheets("申請書").Range("O3").Value .Range("C" & i).Value = Sheets("申請書").Range("E4").Value ・・・・・・・・・・・・・・・・・・・ 2.Sub 申請書保存() Dim NewBookName As String With ThisWorkbook.Sheets("申請書") NewBookName = .Range("F22").Value & " " & .Range("E4").Value & " " & .Range("A2").Value & " " & .Range("A1").Value Worksheets("申請書").ExportAsFixedFormat Type:=xlTypePDF, Filename:="\***\XXXX\1.申請書\申請書" & "\" & NewBookName End With End Sub

VBAでシートの保護

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

お礼 2008/09/22 13:13

その他の回答 (3)

補足 2008/09/22 12:46

補足 2008/09/22 12:41

補足 2008/09/22 11:50

関連するQ&A

エクセル　VBA　シート保存ボタン

VBA　保存

Excel2003VBAでファイルをコピーして指定場所に保存

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

ＶＢＡの記述で、あるシートを別ファイルにした場合

エクセル　シートのみ　保存

VBAで、定数式が必要ですのエラー対応

エクセルVBAでのエラー

エクセル、ワークシートが保護されているかどうかを判断するVBAは？

VBAを実行するとエクセルが落ちる

Excelのブック間の串刺し計算について

ＥＸＣＥＬ　ＶＢＡ　データのある範囲の特定が悪い？

エクセル　ＶＢＡ　シートの選択

VBAでのシート選択について

マクロ　シートの保護

エクセルVBA　ブック間のコピー

フォルダ内の全てのファイル開く時間短縮の方法

Excel VBA で特定のシートのみ除外

vba　ファイルの移動について

VBA中の”シート名”を”アクティブシート”に変更

注目のQ&A

カテゴリ
一覧

専門家に質問してみよう
専門家登録

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

VBAでシートの保護

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

お礼 2008/09/22 13:13

その他の回答 (3)

補足 2008/09/22 12:46

補足 2008/09/22 12:41

補足 2008/09/22 11:50

関連するQ&A

エクセル VBA シート保存ボタン

VBA 保存

Excel2003VBAでファイルをコピーして指定場所に保存

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

ＶＢＡの記述で、あるシートを別ファイルにした場合

エクセル シートのみ 保存

VBAで、定数式が必要ですのエラー対応

エクセルVBAでのエラー

エクセル、ワークシートが保護されているかどうかを判断するVBAは？

VBAを実行するとエクセルが落ちる

Excelのブック間の串刺し計算について

ＥＸＣＥＬ ＶＢＡ データのある範囲の特定が悪い？

エクセル ＶＢＡ シートの選択

VBAでのシート選択について

マクロ シートの保護

エクセルVBA ブック間のコピー

フォルダ内の全てのファイル開く時間短縮の方法

Excel VBA で特定のシートのみ除外

vba ファイルの移動について

VBA中の”シート名”を”アクティブシート”に変更

注目のQ&A

カテゴリ 一覧

専門家に質問してみよう 専門家登録

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

エクセル　VBA　シート保存ボタン

VBA　保存

エクセル　シートのみ　保存

ＥＸＣＥＬ　ＶＢＡ　データのある範囲の特定が悪い？　　

エクセル　ＶＢＡ　シートの選択　

マクロ　シートの保護

エクセルVBA　ブック間のコピー

vba　ファイルの移動について

カテゴリ
一覧

専門家に質問してみよう
専門家登録