ベストアンサー

VBA　保存

2009/11/23 21:11

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

pop2003
お礼率60% (189/311)

オフィス系ソフト
回答数5
ありがとう数5

みんなの回答 （5）
専門家の回答

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

ベストアンサー

Wendy02
ベストアンサー率57% (3570/6232)

2009/11/24 00:13 回答No.3

こんばんは。ご質問の問題は、質問の文章の中では書かれていない部分があるような気がします。ただ、同じ作業をするコードを書く場合は、注意点があります。 >OldWkbook.Sheets(Array(StName1, StName2)).Copy これ自体は問題ないのですが、私は、もう何年もVBAを書いていますが、こういうしゃれた書き方はほとんどしません。複数のシートをSelect して、作業グループ・シートにするときだけです。このコードですと、シートモジュールまで持ってきてしまっています。コントロールツールをコピー後で消すという手法は、出来る限り避けたほうがよいです。コードとしては汚くなりますが、以下のようにしてみたらいかがですか？こういう書き方があります。 '------------------------------------------- 　''OldWkbook.Sheets(Array(StName1, StName2)).Copy 'この部分とShape(1).Deleteをやめて　　'新しいブックを作ったときのシートの枚数　　n = Application.SheetsInNewWorkbook 　　Application.SheetsInNewWorkbook = 2 　　Set NewWkbook = Workbooks.Add 　　With NewWkbook 　　　OldWkbook.Worksheets(StName1).Cells.Copy .Worksheets(1).Range("A1") 　　　.Sheets(1).Name = StName1 　　　OldWkbook.Worksheets(StName2).Cells.Copy .Worksheets(2).Range("A1") 　　　.Sheets(2).Name = StName2 　　End With 　　Application.SheetsInNewWorkbook = n '-------------------------------------------

質問者

お礼 2009/11/24 13:20

ありがとうございます！うまく出来ました！しかし、SHeetの型式や印刷プレビューの形式なども初期化していました。これは、どうにもならないのですか？すいません！是非教えていただきたいです。

その他の回答 (4)

kmetu
ベストアンサー率41% (562/1346)

2009/11/24 18:58 回答No.5

> OldWkbook.Sheets(Array(StName1, StName2)).Copy > Workbooks(2).Activate > Set NewWkbook = ActiveWorkbook > で記述で良いのでしょうか？ブックが1個しか開いていないのでしたらその記述でかまいません。 Workbooks(2).Activateは2番目のブックをアクティブにすると言う意味です。 > 新規に作成とは最初からするのでしょうか？該当部分だけを新しいブックにコピーしてテストしてみてください。それで上手くいったら他の部分もコピーしてください。

質問者

お礼 2009/11/25 22:25

何度も質問してしまいすいませんでした。問題は解決できました。今後とも宜しくお願いします！

Wendy02
ベストアンサー率57% (3570/6232)

2009/11/24 16:52 回答No.4

こんにちは。 >しかし、SHeetの型式や印刷プレビューの >形式なども初期化していました。 >これは、 >どうにもならないのですか？ SHeetの型式や印刷プレビューの形式とは何のことですか？具体的に何を指すのですか？「印刷プレビュー」というのは、概ね「印刷範囲」であろうとは思いますが、「SHeet」の型式という、型式というのは、年代だとすれば、Excel 4.0. Excel 5.0 ダイアログというものがありますが、そういうものは、一般シートとは互換性がありません。

質問者

お礼 2009/11/25 22:23

ありがとうございました！上手く記述ができました。回答にあったように印刷範囲のことです！今後も是非指導の方をお願いします。私ももっともっと勉強が必要です。頑張りますので困ったときには助けて下さい！

kmetu
ベストアンサー率41% (562/1346)

2009/11/23 22:29 回答No.2

こちらで実行したらエラーが出ずに実行されるのですが… もしかしたら OldWkbook.Sheets(Array(StName1, StName2)).Copy の部分で新しいブックがアクティブになっていないかもしれませんので新しいブックをアクティブにしてから (Workbooks(2).Activateとか) Set NewWkbook = ActiveWorkbook を実行してみてはいかがでしょう。また、ファイルが壊れている可能性もありますので新規に作成して実行してみてはいかがでしょう。

質問者

お礼 2009/11/23 22:47

＜新しいブックをアクティブにしてからどのようにすれば良いのですか？すいません！初心者ですので。 OldWkbook.Sheets(Array(StName1, StName2)).Copy Workbooks(2).Activate Set NewWkbook = ActiveWorkbook で記述で良いのでしょうか？＞また、ファイルが壊れている可能性もありますので＞新規に作成して実行してみてはいかがでしょう。新規に作成とは最初からするのでしょうか？

kmetu
ベストアンサー率41% (562/1346)

2009/11/23 21:36 回答No.1

OldWkbook.Sheets(Array(StName1, StName2)).Copy この時点でシートの名前は継承されてますから NewWkbook.Sheets(1).Name = StName1 NewWkbook.Sheets(2).Name = StName2 は不要だと思われます

質問者

お礼 2009/11/23 22:01

ありがとうございます！！ただ不要部分を削除しても上手く保存先に移らずエラーが表示されます！どこに問題があるのでしょうか？

関連するQ&A

エクセル　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でシートの保護
初めまして。私はWindowsXP、Excel2003のVBAでシートの保護、またそれの解除のコードを組んだのですが、以下のコードでは「○○○と言う名前で保存します。よろしければこのままOKをクリックしてください」の箇所でキャンセルを選択した時に、シートの保護を行いたいのですが、どのようなコードにすればよいてのでしょうか？例）　 Dim FileName As String Dim FileExt As String Dim BkName1 As String Dim BkName2 As String Dim BkName3 As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "適材適所グラフ" Const StName2 As String = "適材適所回答" Const StName3 As String = "適性検査III回答" Const StName4 As String = "適性検査IIIグラフ" 'シートの保護を解除 Worksheets("適性検査III回答").Unprotect Worksheets("適材適所回答").Unprotect Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName1 = OldWkbook.Sheets(StName3).Range("L1").Value BkName2 = OldWkbook.Sheets(StName3).Range("L2").Value BkName3 = OldWkbook.Sheets(StName3).Range("L3").Value FileName = BkName1 & 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 OldWkbook.Sheets(Array(StName1, StName2, StName3, StName4)).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 FileName = "C:\採点結果\" & 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 'シートの保護 Worksheets("適性検査III回答").Protect Worksheets("適材適所回答").Protect End Sub
- ベストアンサー
- Visual Basic
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
- ベストアンサー
- Visual Basic
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
- ベストアンサー
- Visual Basic
エクセル　シートのみ　保存
過去の質問も参照しましたが当てはまる物が無くて質問しました！シート上にボタンを作成してクリックするとそのシートのみ指定するファイルにコピーさせたいです！下記の部分で何処を変化させればよいのでしょうか？ (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のみ保存させたいのですが・・　ここからどのようにしたら良いのか　お願いします！教えて下さい。　
- ベストアンサー
- オフィス系ソフト
別フォルダに保存してあるテキストファイルを重複して強制保存したい
別フォルダに保存してあるテキストファイルを重複して強制保存したいのですが、 Sub wsave() '書き出し後の保存 Dim myOldName As String Dim myNewName As String Sheets("AAA").Range("B2").Select If Selection = "" Then Exit Sub Else myOldName = Sheets("AAA").Range("H11") & "HPlist.txt" '変更元ファイル myNewName = Sheets("AAA").Range("H11") & Range("H16") '変更後のファイル名　　　If Len(Dir(myOldName)) > 0 Then Application.DisplayAlerts = False Name myOldName As myNewName Application.DisplayAlerts = True 　　　End If End If 　　Application.Quit End Sub このままではエラー「既に同名のファイルが存在しています」と成り保存されないのです。どなたかよい方法を教えていただけませんでしょうか？
- ベストアンサー
- Visual Basic
VBAを使って名前をつけて保存をしたい(2)
Sub 名前を付けて保存() Dim wSeq As String Dim wStr As String Dim Flnm As String Dim wFlnm As String ' Sheets("データー").Select Range("C3").Select ActiveWorkbook.Save Flnm = "\\Jooo\センタ\AA\CC" & Format(Date, "【mmdd】") & ".xls" If Flnm = "False" Then Exit Sub End If ' wSeq = 0 ExitFlg = False wFlnm = Flnm Do While ExitFlg = False If Dir(Flnm) <> "" Then '存在したら、連番を加算 wSeq = wSeq + 1 wStr = "(" & wSeq & ")" Flnm = Left(wFlnm, Len(wFlnm) - 4) & wStr & ".xls" Else '存在しない時、保存 ActiveWorkbook.SaveAs Filename:=Flnm ExitFlg = True End If Loop End Sub 先日回答者の方から上記コードを教えてもらい助かっているんですが、少し不都合でてきまして、上記を実行すると最初にCC【1022】という名前でフォルダに保存され、二回目に実行するとCC【1022】(1)という名前で同じフォルダに保存され、三回目に実行するとCC【1022】(2)というように連番で同じフォルダに保存されるんですが、一番最初に保存されたCC【1022】を削除して(どんどんBookが溜まっていくのを防ぐ為)四回目に実行すると【1022】(3)ではなく最初のCC【1022】の名前で保存されてしまいます。【1022】を削除してもCC【1022】(3)で保存されるようにするには、コードをどの様にかえたらいいでしょうか?
- ベストアンサー
- オフィス系ソフト
エクセルVBAで保存がうまくいきません
エクセル2000です。下記のようなVBAを記述しました。「はい」なら別名保存「いいえ」なら上書き保存のつもりです。問題点 Sheets("AAA").Range("I9")の文字列内に.(半角ピリオド)があるとファイルに拡張子がつきません。どうしたらよいのでしょうか？非常に困っています。 Sub 保存ボタン() Dim myYN As Integer Dim DRtn As Boolean Dim fn As String, fn2 As String fn = Sheets("AAA").Range("I9").Value & "_保存" fn2 = ThisWorkbook.Name myYN = MsgBox("現在の入力内容を別名で保存しますか？" _ + Chr(&HD) + Chr(&HA) + "別名保存なら「はい」" _ + Chr(&HD) + Chr(&HA) + "上書保存なら「いいえ」を選択します。" _ + Chr(&HD) + Chr(&HA) + "", vbYesNoCancel + vbQuestion, " 別名保存") If myYN = vbCancel Then Exit Sub 'キャンセルなら終了 If myYN = vbNo Then fn = fn2 '上書保存ならファイル名はそのまま DRtn = Application.Dialogs(xlDialogSaveAs).Show(ARG1:=fn, ARG2:=1) If DRtn = False Then Exit Sub 'ファイル名を消されたらキャンセル ThisWorkbook.Save '保存 ThisWorkbook.Close '閉じる End Sub
- ベストアンサー
- オフィス系ソフト
シートだけを保存したいのですが？
はじめましてマクロ初心者です。検索しましたがわからなかったので、質問させていただきます。保存をキャンセルすると新規ブックができてしまいます。キャンセルした時に新規ブックを作りたくないのですが、教えてください。 Sub シート保存() Dim Answer3 Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant Answer3 = MsgBox("本当に保存しますか？", vbYesNo) If Answer3 = vbYes Then Sheets("保存シート").Select Application.CutCopyMode = False Sheets("保存シート").Copy Else MsgBox ("キャンセルしました。") End If 既定ファイル名 = Range("V8") 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名) If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Else ActiveWorkbook.SaveCopyAs 保存ファイル名 End If 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
- ベストアンサー
- オフィス系ソフト

VBA　保存