エクセルマクロでコピー貼付を禁止する方法 -エクセルでコピー貼付を禁止する-

エクセル　ルーチンマクロ

以前コピー・貼り付けを停止させる為に、下記マクロを参照させて頂いたのですが、 '--------------------------------------------------------------- Sub DisableCommandButtons(Cmd_bln As Boolean) 'コピー・貼り付けを停止させるサブルーチン・マクロ　Dim cmd As Variant 　Dim Cmdb As Object 　Dim CmdNames As Variant 　CmdNames = Array("Worksheet Menu Bar", "Cell", "Column", "Row") 　'ショートカットのインスタンス　If Cmd_bln = False Then 　　Application.OnKey "^c", "" 　　Application.OnKey "^v", "" 　　Application.OnKey "^x", "" 　Else 　　Application.OnKey "^c" 　　Application.OnKey "^v" 　　Application.OnKey "^x" 　End If 　'コマンドボタンのEnable 　For Each cmd In CmdNames 　If cmd = "Worksheet Menu Bar" Then 　　With Application.CommandBars(cmd).Controls(2) 　　 .Controls(3).Enabled = Cmd_bln 　　 .Controls(4).Enabled = Cmd_bln 　　 .Controls(5).Enabled = Cmd_bln 　　End With 　Else 　　With Application.CommandBars(cmd) 　　　.FindControl(, 19).Enabled = Cmd_bln 'Copy 　　　.FindControl(, 22).Enabled = Cmd_bln 'Paste 　　　.FindControl(, 21).Enabled = Cmd_bln 'Cut 　　End With 　End If 　Next cmd End Sub '--------------------------------------------------------------- このマクロを実行した所、コンテキストメニュー及びショートカットキーのコピー、貼付が無効になりました。 EnableCommandButtons　というマクロを別に作りショートカットのインスタンスの　If Cmd_bln = False Then　を　If Cmd_bln = True Then　に書き換えて、実行した所、ショートカットキーは有効になったのですがコンテキストメニューのコピー、貼付を有効にするやり方がわかりません。以前、同じ質問させていただき、ご回答頂いたのですが、別のPCでは、その方法でもダメなことが分かりました。 OSはXP Pro エクセルはは2003ですどなたか、助けていただけないでしょうか？よろしくお願い致します。

Excel2003でブックごとにコピー&ペースト不可の制限

過去の記事なども調べ下記でアプリケーション単位での設定はわかりました。しかし全ブックに影響がでるのはこまるのでこれをブック単位に設定することはできますでしょうか。お願いします！ ▽ソース Sub Auto_Open() Call DisEnableKeys1 Call DisEnableKeys2 End Sub Sub DisEnableKeys1() Dim eFlg As Boolean eFlg = False 'サブルーチンにしてトグルも可能 With Workbook .CommandBars("Worksheet Menu Bar").Controls("編集(&E)").Controls("貼り付け(&P)").Enabled = eFlg .CommandBars("Cell").FindControl(, 22).Enabled = eFlg If eFlg = False Then .OnKey "^v", "DummyMacro1" Else .OnKey "^v" End If End With End Sub Sub DisEnableKeys2() Dim eFlg As Boolean eFlg = False 'サブルーチンにしてトグルも可能 With Workbook .CommandBars("Worksheet Menu Bar").Controls("編集(&E)").Controls("コピー(&C)").Enabled = eFlg .CommandBars("Cell").FindControl(, 19).Enabled = eFlg If eFlg = False Then .OnKey "^c", "DummyMacro2" Else .OnKey "^c" End If End With End Sub Sub DummyMacro1() MsgBox "貼り付けは禁止されています。", vbInformation End Sub Sub DummyMacro2() MsgBox "コピーは禁止されています。", vbInformation End Sub

エクセル　マクロ　初心者です

エクセルマクロ初心者です。以下の２つの Private Sub Worksheet_Change(ByVal Target As Range)を１つのシートで実行させたいのですが、当方、初心者なので組み合わせ方が分かりません。よろしくお願いします。 ===No1=== Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Target = StrConv(Target, vbUpperCase) Application.EnableEvents = True End Sub ===No2=== Private Sub Worksheet_Change(ByVal Target As Range) Dim Ans As Integer If Target.Count = 1 Then Ans = MsgBox("コピーは禁止!!", vbCritical) MsgBox "データを消去します。" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If If Target.Count = 1 Then Exit Sub Else MsgBox “複数セルのコピー禁止！" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If End Sub ------------ 上記の２つを１つのシートで動作させたいのですが、うまくいきません。単体では、動作します。

PowerPointでマクロをショートカットキーに割り当てる方法

現在、エクセルで以下のようなマクロをアドインとして作成して、「CTRL+,」と「CTRL+.」で表示倍率を変えれるようなショートカットを割り当ててます。同じことをパワーポイントでアドインを作成してやろうとすると、Application.OnKeyのところでエラーになってしまいます。同じVBAでも違うんでしょうか。 PowerPointで同じことをやろうとするとどうすればいいでしょうか? ご存知の方がいらっしゃれば教えてください。 ==================================================== Option Explicit Sub auto_open() Start 1 End Sub Sub Start(num%) Dim myBar As CommandBar Dim myCtrl As CommandBarControl Application.OnKey "^{.}", "Zoomup" Application.OnKey "^{,}", "Zoomdown" End Sub Sub Zoomup() If ActiveWindow.Zoom < 390 Then ActiveWindow.Zoom = ActiveWindow.Zoom + 5 End If End Sub Sub Zoomdown() If ActiveWindow.Zoom > 10 Then ActiveWindow.Zoom = ActiveWindow.Zoom - 5 End If End Sub

エクセルのマクロについて

Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "ア") = 0 Then If InStr(.Cells(i, "D"), "ア(半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub このエクセルマクロはC列に「ア」があって、D列に「ア(半角)」の文字がない場合はメッセージというマクロなのですが、このマクロをア～ンまで同じ作業をしたいのですが、ひとまとめにマクロを組む事はできるのでしょうか？できる場合どのようにすれば良いでしょうか? 下記のようにして見たのですができませんでした。 Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "[ア-ン]") = 0 Then If InStr(.Cells(i, "D"), "[ア-ン](半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub

エクセルのマクロについて教えて下さい。

エクセル2000を使用している初心者です。マクロは昨日ここで、ご指導いただいたばかりです。過去ログを参考にあるホームページから赤いフォントを数えるマクロを、カレンダーの年間休日数を数えるためにコピーしました。１日かかって、動作する様にはなったのですが私が範囲指定している場所の個数より多く、またシート全体の赤いフォントの個数よりも多い様なのです。以下にコピーしますのでどこがおかしいのかご指導願えないでしょうか。 Sub 休日検索() Dim myRng As Range Dim myFlag As Byte Dim myBoldCnt As Long, myRedCnt As Long Dim myBoldOrRedCnt As Long, myBoldAndRedCnt As Long For Each myRng In Range("検索範囲")※私の書き換えたのはここだけ myFlag = 0 With myRng If .Font.Color = RGB(255, 0, 0) Then myFlag = myFlag + 1 If .Font.Bold Then myFlag = myFlag + 2 End With If myFlag And 1 Then myRedCnt = myRedCnt + 1 If myFlag And 2 Then myBoldCnt = myBoldCnt + 1 If myFlag And 3 Then myBoldOrRedCnt = myBoldOrRedCnt + 1 If myFlag = 3 Then myBoldAndRedCnt = myBoldAndRedCnt + 1 Next MsgBox "太字" & vbtab & vbtab & myBoldCnt & vbcrlf _ & "赤" & vbtab & vbtab & myRedCnt & vbcrlf _ & "太字または赤" & vbtab & myBoldOrRedCnt & vbcrlf _ & "太字かつ赤" & vbtab & myBoldAndRedCnt End Sub

エクセルVBAのエラーについて

お世話になります。エクセルでマクロを作成しているのですが、デバッグ中にマクロを無効にするを選択した後マクロを有効にするで起動すると「MicrosoftExcel は動作を停止しました」になります。終了させてマクロを無効にするで上書きをして再起動すると動作します。原因は何なのでしょうか？コードは以下です。・ThisWorkbook_Open ActiveWorkbook.Application.Visible = False UserForm1.Show ・UserForm_Activate Set clsUsrfrm = New kroboCls ・クラス側コンストラクタ With UserForm1 Set EV_pg = .MultiPage1 Set EV_cmbKind = .cmbKind Set EV_cmdUpdate = .cmdUpdate Set EV_cmdDel = .cmdDel Set EV_cmdHistExcel = .cmdHistExcel Set EV_cmdMoveExcel = .cmdMoveExcel Set Ev_cmdEnd = .cmdEnd Set EV_cmd1s = .cmd1s Set EV_cmd2s = .cmd2s Set EV_cmd3s = .cmd3s Set EV_cmd4s = .cmd4s Set EV_cmd5s = .cmd5s Set EV_ScmdUpdate = .ScmdUpdate Set EV_Scmds = .scmds Set EV_ScmdBack = .ScmdBack Set EV_ScmdNext = .ScmdNext Set EV_cmdHistExcel = .ScmdHistExcel Set EV_ScmdMoveExcel = .ScmdMoveExcel End With If initDisp() = False Then Call errProc("kRoBOCls-Class_Initialize", "initDisp-err") End if Private Function initDisp() As Boolean Dim i As Integer On Error GoTo errTrap initDisp = True With UserForm1 With .cmbKind .Clear .AddItem "値上がり" .AddItem "値下がり" .AddItem "ストップ高" .AddItem "ストップ安" .AddItem "出来高" .AddItem "時価総額上位" .AddItem "時価総額下位" .AddItem "単元株価格上位" .AddItem "単元株価格下位" .AddItem "配当利回り" .AddItem "高ＰＥＲ" .AddItem "低ＰＥＲ" .AddItem "高ＰＢＲ" .AddItem "低ＰＢＲ" .ListIndex = 0 End With .op50.Value = True .dateTime = "------" For i = 1 To 60 .Controls("op" & i).Enabled = False .Controls("op" & i).Value = False Next For i = 1 To 10 .Controls("DEL" & i).Enabled = False Next .cmd1s.Enabled = False .cmdHistExcel.Enabled = False .cmdMoveExcel.Enabled = False .cmd2s.Enabled = False .cmd3s.Enabled = False .cmd4s.Enabled = False .cmd5s.Enabled = Falss .SdateTime = "----------" .ScmdBack.Enabled = False .ScmdNext.Enabled = False .ScmdHistExcel.Enabled = False .ScmdMoveExcel.Enabled = False .scmds.Enabled = False For i = 1 To 50 .Controls("J" & i).TextAlign = fmTextAlignRight .Controls("C" & i).TextAlign = fmTextAlignRight .Controls("T" & i).TextAlign = fmTextAlignRight .Controls("R" & i).TextAlign = fmTextAlignRight .Controls("Z" & i).TextAlign = fmTextAlignRight .Controls("H" & i).TextAlign = fmTextAlignRight .Controls("D" & i).TextAlign = fmTextAlignRight Next End With Exit Function errTrap: initDisp = False End Function とりあえず、関係しそうなところを入れました。よろしくお願いいたします。

VBA を使用してexcel起動時に　右クリックメニューの行削除や列削除を無効にしようとするとエラーが出ることがある。

お世話になります。 VBA を使用してexcel起動時に　右クリックメニューの行削除や列削除を無効して、下記ＶＢＡを作成しました。しかしながら、起動時（実行時）に「実行時エラー 5　プロシージャの呼び出し、または引数が不正です。」が出ることがあります。でないときもあるのですが、デバック時にとまるところは、毎回変わり(1)～(5)のどれかで止まります。使用したい環境はexcel2007,excel2003で正常に動くようにしたいのですが、何卒よろしくお願いします。 *************ソース********************* Private Sub Workbook_Open() InsertEnabled False End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) InsertEnabled True End Sub Private Sub InsertEnabled(flg As Boolean) With Application (1) Application.CommandBars("Worksheet Menu Bar").Controls("挿入(&I)").Enabled = flg (2) Application.CommandBars("Cell").Controls("挿入(&I)...").Enabled = flg (3)Application.CommandBars("Cell").Controls("削除(&D)...").Enabled = flg (4)Application.CommandBars("Row").Controls("挿入(&I)").Enabled = flg (5)Application.CommandBars("Row").Controls("削除(&D)").Enabled = flg .CommandBars.FindControl(, 296).Enabled = flg .CommandBars.FindControl(, 293).Enabled = flg End With End Sub

マクロ（メニュー選択できないような）を教えてください。

エクセル2003や2007でセル上で右クリックしたときに、表示されるインスタントメニューで、切り取り(Ｔ)　をグレー表示にして選択できないようなマクロを次のようにしてあります。同様に、コピー（Ｃ）、貼り付け（Ｐ）、形式を選択して貼り付け（Ｓ）もグレー表示にして選択できないようにしたいと思います。マクロ記述を教えてください。よろしくお願いします。 Sub MenuOff() Dim CBar Set CBar = Application.CommandBars("Cell").Controls With CBar For i = 1 To .Count If (.Item(i).Caption Like "切り取り*") Then .Item(i).Enabled = False Exit For End If Next i End With End Sub

エクセルのマクロを利用して

マクロ初心者でです。いろんなサイトから引用させて頂き次のようなマクロを作成しました。実行すると、日付と担当者氏名(A1)がファイル名となるものです。そこで教えて頂きたいのですが、実行すると保存先がマイドキュメントになるのですが、これを例えば「C:\日報」というフォルダが指定されるようにしたいのですが、自分なりに、いろいろ試したのですが全くできません。宜しくお願い致します。 Sub 名前をつけて保存() Dim SaveFileName As String, re As Variant With Sheets("sheet1").Range("A1") If .Value = "" Then MsgBox "名前が入力されていません", vbExclamation Exit Sub Else SaveFileName = Format(Now, "yyyymmdd") & "_" & .Value End If End With re = Application.GetSaveAsFilename(SaveFileName) If re = False Then MsgBox "保存を中止しました", vbExclamation Else MsgBox "日報をを保存しました", vbInformation End If End Sub

excel2002vbaで選択しているセルがハイパーリンクとそれ以外のものを区別する方法

ハイパーリンクをenterキーでリンク先に飛べるようにマクロを挿入したのですが、ハイパーリンク以外のセルでenterキーを押下した時に、「インデックスが有効範囲にありません」というエラーメッセジが表示されていまい通常のセル移動が行えません。使用しているマクロは以前に掲載されていた以下のマクロをしようしています。何かいい方法はあるでしょうか？ Sub Auto_Open() '起動時　キー設定　On Call SettingKeys(True) End Sub Sub Auto_Close() '終了時　キー設定　Off Call SettingKeys(False) End Sub Sub SettingKeys(flg As Boolean) If flg Then Application.OnKey "{Enter}", "JumpHyperLink" Application.OnKey "~", "JumpHyperLink" Else Application.OnKey "{Enter}" Application.OnKey "~" End If End Sub Sub JumpHyperLink() If TypeName(Selection) = "Range" Then Selection.Hyperlinks(1).Follow NewWindow:=False End If End Sub

EXCELで作ったマクロを別のファイルのEXCELでも使えるようにしたいです。

(1)EXCELファイルでマクロを作成しました。 (実際はここである人の知恵をお借りして作ったものですが…) しかし、(2)EXCELファイルで(1)EXCEL作成マクロが実行できません。どのような処理をすれば、どのPCでも、どのファイルでも実行できるようなマクロに出来るのでしょうか？？以下にそのマクロを示します。 ↓↓↓ Sub 文字置換() '半角カタカナを全角に、全角英数を半角にするマクロ　(Excel編） Dim rng As Range Dim Re As Object Dim myPat As String Dim c As Range Dim Matches As Object Dim Match As Object Dim Str1 As String Dim Str2 As String Dim buf As String Dim t As Long On Error Resume Next Set rng = ActiveSheet.UsedRange.SpecialCells _ (xlCellTypeConstants, xlTextValues) On Error GoTo 0 If rng Is Nothing Then MsgBox "変換する対象が見当たりません。", 48 Exit Sub End If '全角側　---　半角側 (！-／を加えれば記号も半角) myPat = "([\uFF66-\uFF9F]*)([！-｝]*)" '正規表現のパターン Set Re = CreateObject("VBScript.RegExp") Application.ScreenUpdating = False With Re .Global = True .IgnoreCase = True .Pattern = myPat For Each c In rng.Cells Set Matches = .Execute(c.Value) If Matches.Count > 0 Then buf = c.Value For Each Match In Matches If Len(Match.Value) > 0 Then Str1 = StrConv(Match.SubMatches(0), vbWide) If Str1 <> "" Then '0 =vbBinaryCompare buf = Replace(buf, Match.SubMatches(0), Str1, , , 0) End If Str2 = StrConv(Match.SubMatches(1), vbNarrow) If Str2 <> "" Then buf = Replace(buf, Match.SubMatches(1), Str2, , , 0) End If End If Str1 = "": Str2 = "" Next Match If buf <> c.Value Then c.Value = buf t = t + 1 End If End If Next c End With Set Re = Nothing Application.ScreenUpdating = True If t > 0 Then MsgBox t & "個のセルを変換しました。", 64 End If End Sub 出来れば、置換した文字数をメッセージBOXに表示したいです。

エクセルのマクロについて教えていただきたいのですが・・・

見積書を作成しているんですが、1枚目のシート（見積書）に明細が書ききれなかった時に、マクロを実行すると、『明細書』と言う名前のシートが(1)～(5)枚目まで追加され、各シートの小計を1枚目のシートに書き出す・・・と言うマクロを作りたいのですが、うまくいかずに困っています＞＜追加されるシートの元となる『見積もりマスター』と言うシートがあって、そのシート内でそれぞれのシートの小計は取れるのですが・・・下記のマクロの中に何か追加すればうまくいく方法はありますか？？（明細書は追加する時もあれば追加しない時もあってその都度、使う人が、最大5枚まで何枚追加するかを決めるそうです。） Sub Macro1() Dim cnt As Integer Dim wkNum As Double Dim ws As Worksheet 　For Each ws In Worksheets 　　If Left(ws.Name, 4) = "明細書(" Then 　　　If IsNumeric(Mid(ws.Name, 5, 1)) Then 　　　　wkNum = Val(Mid(ws.Name, 5, 1)) 　　　　If cnt < wkNum Then 　　　　　cnt = wkNum 　　　　End If 　　　End If 　　End If 　Next ws 　If cnt >= 5 Then 　　MsgBox ("明細書シートが既に５枚以上あるため追加できません") 　　Exit Sub 　Else 　　Sheets("明細マスター").Copy after:=Sheets(Worksheets.Count) 　　ActiveSheet.Name = "明細書(" & cnt + 1 & ")" 　End If End Sub マクロ自体をあまり理解できてなくて、会社の人や、ここで教えていただいて進めているので、出来ればそのままコピーして使用できるようにしていただけるとありがたいです。よろしくお願いします。

エクセル　マクロ：チェックボックス　コピー

教えてください。 sheet1にデータがあり sheet2にチェックボックスとコマンドボタンがあります。チェックボックスにレ点を入れ、コマンドボタンを押すと sheet1の該当する列をコピーして、sheet3に貼り付けるマクロを作ろうと思ってますがうまくいきません。下記のマクロを使えるように手直ししていただけないでしょうか。よろしくお願い致します。 Private Sub CommandButton1_Click() Dim myrange As String Dim rmax As Long rmax = Sheets("sheet1").Range("A2").End(xlDown).Row With Sheets("sheet2") If .CheckBox1 Then myrange = myrange & ",$B$1:$B$" & rmax If .CheckBox2 Then myrange = myrange & ",$C$1:$C$" & rmax If .CheckBox3 Then myrange = myrange & ",$D$1:$D$" & rmax End With If myrange = "" Then MsgBox "チェックしてください" Exit Sub End If myrange = "$A$2:$A$" & rmax & myrange Sheets("sheet1").Range(myrange).Copy Sheets("sheet3").Range("A1").PasteSpecial xlPasteValues Application.CutCopyMode = False Sheets("sheet3").Select End Sub

エクセル　マクロ

エクセルのある特定のセルをダブルクリックすると画像ファイルを参照しにいき貼りつけたい画像ファイル選ぶとそのセルの大きさに合わせて画像ファイルがそのセルに貼りつくというマクロが以下の通りなんですが Excel2003からExcel2007へ変更すると画像ファイルの貼りつく位置がダブルクリックしたセルではない所に貼りつくようになりました参照や大きさなどはちゃんと機能しているようですどこを変更すればよいでしょうか？ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range('特定のセル)) Is Nothing Then Exit Sub Cancel = True Dim myPic Dim myRange As Range Dim rX As Double, rY As Double myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If VarType(myPic) = vbBoolean Then Exit Sub Set myRange = Target Application.ScreenUpdating = False With ActiveSheet.Pictures.Insert(myPic).ShapeRange rX = myRange.Width / .Width rY = myRange.Height / .Height If rX > rY Then .Height = .Height * rY Else .Width = .Width * rX End If .Left = .Left + (myRange.Width - .Width) / 2 .Top = .Top + (myRange.Height - .Height) / 2 End With Application.ScreenUpdating = True Cancel = True End Sub

■助けてください。■エクセルのマクロで困っています。

エクセルで、シートを一つ削除するマクロを教えてください。本当に困っています。マクロをご存知の方、ずぶの素人の私にご教示何卒よろしくお願いします。文末にマクロを記述いたしますが、そちらは、指定した日付以降にエクセルのファイルを開くとシートがすべて削除されて、「有効期限切れ」というシートだけが出てくるというものです。現在、これを応用して、すべてのシートを削除するのではなく、ひとつのシートだけ削除したいのです。例えば「SheetA」、「SheetB」、「SheetC」、「有効期限切れ」という４つのシートがあったとして、指定した期日が来たら、「SheetC」だけを削除したいのです。なお、エクセルファイルを開く際に、マクロを無効にされてしまうと期日が来てもSheetCが削除されずに残ってしまっては困るのです。そこで、マクロを有効にしないと SheetCが現れないようにしたいのです。（以下のマクロではそのようになっています）一つだけシートを削除するマクロをやり方をご存知の方、マクロのご教示のほど何卒よろしくお願い致します。なお、小生、マクロはずぶの素人でして、マクロの文面を頂いてコピー貼り付けするぐらいしか能がありません。つきましては、以下の文面をモディファイしてご教示頂けませんでしょうか。よろしくお願いいたします。 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) endsheetname = "有効期限切れ" If (Sheets.Count = 1) And (Sheets(1).Name = endsheetname) Then Exit Sub If Sheets("SheetA ").Visible Then Sheets("SheetC ").Visible = xlVeryHidden End Sub Private Sub Workbook_Open() endsheetname = "有効期限切れ" If Date >= "3008/09/29" Then Application.DisplayAlerts = False If Sheets.Count = 1 Then If Sheets(1).Name <> endsheetname Then Sheets.Add(After:=ActiveSheet).Name = endsheetname End If Else On Error Resume Next Sheets(endsheetname).Delete On Error GoTo 0 Sheets.Add(After:=ActiveSheet).Name = endsheetname End If sheetnumber = Sheets.Count For i = 1 To sheetnumber For j = 1 To 2 If Sheets.Count = 1 Then Exit For If Sheets(j).Name = " SheetC " Then If Not Sheets("SheetC ").Visible Then Sheets("SheetC ").Visible = True If Sheets(j).Name <> endsheetname Then Sheets(Sheets(j).Name).Delete: Exit For Next Next Range("b" & 3).Value = "ご利用ありがとうございました。" ActiveWorkbook.Save Application.DisplayAlerts = True End If If (Sheets.Count = 1) And (Sheets(1).Name = endsheetname) Then Exit Sub If Not Sheets(" SheetC ").Visible Then Sheets(" SheetC ").Visible = True End Sub

大量のエクセルの共通項目を一つのエクセルにまとめる

Windows10のoffice2016を使用しています。マクロ初心者です。仕事でエクセルファイルのデータ整理をしなければいけないのですが、コピー元のエクセルファイルが千単位であり、手作業だと時間がかかりすぎるため、VBAでマクロが動かなくて困っています。調べながら書いておりますが、なぜ動かないかわかっておりません。コピー元の多くのエクセルファイルと貼付先の一つのエクセルファイルがあります。コピー元のエクセルファイルは、”計算フォルダ”というフォルダに入っており、その各々のファイルには、“仕様””日時””用途”とその右隣には値が入力されています。行いたいことは、コピー元のファイル内の”仕様””日時””用途”をFindで探して、その隣の値をコピーして、貼付先のエクセルファイルの”貼付先1”というシートに、順に貼付けすることです。皆さまのお知恵をどうか貸してください。よろしくお願いします。 Sub 取り込みマクロ() Dim objFSO As Object Dim objBook As Object Dim n As Long Dim rngSearch1, rngSearch2, rngSearch3, varSearch Dim myRange As Range Dim FolderPath As String FolderPath = ThisWorkbook.Path & "\計算フォルダ" Set objFSO = CreateObject("Scripting.FileSystemObject") For Each objBook In objFSO.GetFolder(FolderPath).Files n = ThisWorkbook.Sheets("貼付先1").Cells(Rows.Count, "A").End(xlUp).Row + 1 Workbooks.Open objBook.Path Worksheets("コピー元").Activate Set rngSearch1 = .Worksheets("コピー元").Find("仕様") Set rngSearch2 = .Worksheets("コピー元").Find("日時") Set rngSearch3 = .Worksheets("コピー元").Find("用途") If rngSearch1 Is Nothing Then Else rngSearch1.Offset(0, 1).Value.Copy.Sheets("貼付先1").Range ("B" & 1 + n) End If If rngSearch2 Is Nothing Then Else rngSearch2.Offset(0, 1).Value.Copy.Sheets("貼付先1").Range ("C" & 1 + n) End If If rngSearch3 Is Nothing Then Else rngSearch3.Offset(0, 1).Value.Copy.Sheets("貼付先1").Range ("D" & 1 + n) End If With Rows("185").Copy ThisWorkbook.Sheets("貼付先1").Rows(n).PasteSpecial Application.CutCopyMode = False ActiveWorkbook.Close SaveChanges:=False End With On Error Resume Next Next Set objFSO = Nothing MsgBox "完了！" End Sub

エクセルマクロ　特定の文字列を含む行のみを残す　（マクロ修正）

以下のマクロは、EXCEL２００３で「特定の文字列が含まれている列を削除する」動作をするマクロです Sub Macro1() Const col As String = "A"　'文字列が入力されている列 Dim idx As Long Dim keyWord keyWord = Application.InputBox("削除対象の文字列は？", Type:=2) If TypeName(keyWord) <> "Boolean" And Len(keyWord) > 0 Then 　　For idx = Cells(65536, col).End(xlUp).Row To 1 Step -1 　　　　If InStr(Cells(idx, col).Value, keyWord) > 0 Then '　　　　If Application.CountIf(Rows(idx), "*" & keyWord & "*") > 0 Then 　　　　　　Rows(idx).Delete 　　　　End If 　　Next idx End If End Sub このマクロを、「特定の文字列が含まれている行のみを残し、それ以外を削除する」というマクロに変更したいと思っています。是非ご回答お願いいたします。

マクロに手を加えたいのですが・・・・・

マクロに手を加えたいのですが・・・・・下記のマクロの式があるのですが、全シートの　ＡＫ８にデーターが０以上だったら指定の範囲のデーター週払い一覧にコピーしなさいと、　書いてあるのだとおもうのですが・・・　（素人なので、分かりませんが）これだと　１件だけ要らないデーターを読みこんでしまいます。色んなシート名が有りますが、　欲しいデータのあるシート名は、必ずSheet番号となっているので、 Sheet１～Sheet５０までのデーターから　（シートNOは、増えたりします） Sheetの名前から　始まる等の指定をしたいのですが、どのように　書き換えればよろしいでしょうか、 Sub test() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "週払一覧" Then With Worksheets("週払一覧") If Sh.Range("AJ８").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("AB3:AK8").Copy .Cells(1) .Resize(6, 10).Value = Sh.Range("AB3:AK8").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub 私の勘ですが(笑)　If Sh.Range("AJ８").Value > 0 Thenの IF　Sｈを　If　ｓｈ""　とか　Sh（"　"）　とか　Sh（i）とか＠とかやりましたが　、できませんでした、初歩的な事でしょうが、　教えてくださいお願いします。

エクセルのマクロコードについて

エクセルのマクロコードに付いて教えて下さい。下記のマクロコードがありますが、 Option Explicit ' Private Sub Worksheet_Change(ByVal Target As Range) ' 　　Static Memo(1 To 3) As Long 　　Dim Cell As Range ' 　　If Intersect([A1:C1], Target) Is Nothing Then 　　　　Exit Sub 　　End If ' 　　For Each Cell In Target ' 　　　　If Cell = "" Then 　　　　　　Memo(Cell.Column) = 0 　　　　End If 　　Next Cell 　　Set Cell = Target(1) ' 　　If Not IsNumeric(Cell) Or Cell = "" Then 　　　　Exit Sub 　　End If ' 　　Application.EnableEvents = False 　　Memo(Cell.Column) = Memo(Cell.Column) + Target 　　Target = Memo(Cell.Column) 　　Application.EnableEvents = True End Sub セル位置の指定を変更する場合は、どの様に書けば良いのですか？このコードですと、セルＡ1からc1の入力指定でなっていますがＡ1からAA1までとかにする場合やA1の結果を、A1ではなくA2に表示Ｂ1の結果をＢ2に表示する場合はどのように書くのでしょうか？マクロに付いて、殆ど知識が無いものですので出来れば、分かり易い説明でお願いします。宜しくお願いします。

エクセルマクロでコピー貼付を禁止する方法

エクセルルーチンマクロ

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

お礼 2008/08/24 11:04

その他の回答 (2)

関連するQ&A

エクセル　ルーチンマクロ

Excel2003でブックごとにコピー&ペースト不可の制限

エクセル　マクロ　初心者です

PowerPointでマクロをショートカットキーに割り当てる方法

エクセルのマクロについて

エクセルのマクロについて教えて下さい。

エクセルVBAのエラーについて

VBA を使用してexcel起動時に　右クリックメニューの行削除や列削除を無効にしようとするとエラーが出ることがある。

マクロ（メニュー選択できないような）を教えてください。

エクセルのマクロを利用して

excel2002vbaで選択しているセルがハイパーリンクとそれ以外のものを区別する方法

EXCELで作ったマクロを別のファイルのEXCELでも使えるようにしたいです。

エクセルのマクロについて教えていただきたいのですが・・・

エクセル　マクロ：チェックボックス　コピー

エクセル　マクロ

■助けてください。■エクセルのマクロで困っています。

大量のエクセルの共通項目を一つのエクセルにまとめる

エクセルマクロ　特定の文字列を含む行のみを残す　（マクロ修正）

マクロに手を加えたいのですが・・・・・

エクセルのマクロコードについて

注目のQ&A

カテゴリ
一覧

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

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

エクセルマクロでコピー貼付を禁止する方法

エクセル ルーチンマクロ

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

お礼 2008/08/24 11:04

その他の回答 (2)

関連するQ&A

エクセル ルーチンマクロ

Excel2003でブックごとにコピー&ペースト不可の制限

エクセル マクロ 初心者です

PowerPointでマクロをショートカットキーに割り当てる方法

エクセルのマクロについて

エクセルのマクロについて教えて下さい。

エクセルVBAのエラーについて

VBA を使用してexcel起動時に 右クリックメニューの行削除や列削除を無効にしようとするとエラーが出ることがある。

マクロ（メニュー選択できないような）を教えてください。

エクセルのマクロを利用して

excel2002vbaで選択しているセルがハイパーリンクとそれ以外のものを区別する方法

EXCELで作ったマクロを別のファイルのEXCELでも使えるようにしたいです。

エクセルのマクロについて教えていただきたいのですが・・・

エクセル マクロ：チェックボックス コピー

エクセル マクロ

■助けてください。■エクセルのマクロで困っています。

大量のエクセルの共通項目を一つのエクセルにまとめる

エクセルマクロ 特定の文字列を含む行のみを残す （マクロ修正）

マクロに手を加えたいのですが・・・・・

エクセルのマクロコードについて

注目のQ&A

カテゴリ 一覧

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

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

エクセルルーチンマクロ

エクセル　ルーチンマクロ

エクセル　マクロ　初心者です

VBA を使用してexcel起動時に　右クリックメニューの行削除や列削除を無効にしようとするとエラーが出ることがある。

エクセル　マクロ：チェックボックス　コピー

エクセル　マクロ

エクセルマクロ　特定の文字列を含む行のみを残す　（マクロ修正）

カテゴリ
一覧

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