VBAを使用してCSVデータをエクセルにまとめる方法
- VBAを使用して同一フォルダ内のCSVデータをエクセルのワークブックにまとめる方法を教えてください。
- デバッグモードでは問題なく動作するVBAコードが、通常の実行ではエクセルが閉じてしまいます。原因が分からず困っています。
- 使用している環境はWin7のOffice2013です。ご指摘いただけると助かります。
- ベストアンサー
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
- 40104
- お礼率56% (18/32)
- Excel（エクセル）
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
＞ActiveWorkbook.Close False クローズするウィンドゥを「明示」してクローズする事。 FileA = "C:\Users\Public\Documents\01.csv" （略） ActiveWorkbook.Close False を FileA = "C:\Users\Public\Documents\01.csv" （略） Application.Windows("01.csv").Close SaveChanges:=False に変更。同様に FileB = "C:\Users\Public\Documents\02.csv" （略） ActiveWorkbook.Close False を FileB = "C:\Users\Public\Documents\02.csv" （略） Application.Windows("02.csv").Close SaveChanges:=False に変更。同様に FileC = "C:\Users\Public\Documents\03.csv" （略） ActiveWorkbook.Close False を FileC = "C:\Users\Public\Documents\03.csv" （略） Application.Windows("03.csv").Close SaveChanges:=False に変更。 ステップ実行ではなく、一気に実行すると「アクティブなワークブック」が「ThisWorkbook」のまま切り替わらないで「ActiveWorkbook.Close False」が実行されてしまう。 つまり「csvファイルでなく、自分自身が閉じられてしまう」事になる。 自分自身が閉じられれば、エクセルそのものも閉じられてしまうことになる。
関連するQ&A
- EXCEL、VBAについて
' GLOBAL変数の定義 Dim CurrentDir As String '現在のディレクトリ Dim ThisBook As String '現在のブック名 Dim WorkSheetName1 As String Dim WorkSheetName2 As String Dim ConfigSheetName As String Dim ListSheetName1 As String Dim ListSheetName2 As String Dim ListSheetName3 As String Dim ListSheetName4 As String Dim ListSheetName5 As String Dim ListSheetName6 As String Dim ListSheetName7 As String Dim ErrorFlag As Integer 'エラーフラグ 0:正常 1:エラー Sub 初期設定() CurrentDir = ActiveWorkbook.Path '現在のディレクトリ ThisBook = ActiveWorkbook.Name '現在のブック名 WorkSheetName1 = "work1" WorkSheetName2 = "work2" ConfigSheetName = "設定" ListSheetName1 = "****" ListSheetName2 = "****" ListSheetName3 = "****" ListSheetName4 = "****" ListSheetName5 = "****" ListSheetName6 = "****" ListSheetName7 = "****" Application.DisplayAlerts = False 'EXCELの警告を無視する End Sub Sub CSV取り込み() Dim LoadBook As String '読み込みブック名 Dim DataMaxCol As Integer '読み込みデータ有効最大カラム数 Dim WorkStartRow As Integer 'workシート開始行 Dim WorkEndRow As Integer 'workシート終了行 Dim ListMaxCol As Integer '一覧シート有効最大カラム数 Dim ListStartRow As Integer '一覧シート開始行 '初期設定コール Call 初期設定 'workシートをクリア DataMaxCol = Sheets(ConfigSheetName).Range("F2").Value WorkStartRow = Sheets(ConfigSheetName).Range("F3").Value WorkEndRow = Sheets(ConfigSheetName).Range("F4").Value Sheets(WorkSheetName1).Select Range(Cells(WorkStartRow, 1), Cells(WorkEndRow, DataMaxCol)).ClearContents '受注データファイルを選択しオープン SelectedPath = Application.GetOpenFilename("CSVファイル (*.csv), *.csv") If SelectedPath <> "False" Then Workbooks.Open Filename:=(SelectedPath) Else 'キャンセル時は終了 Exit Sub End If LoadBook = ActiveWorkbook.Name '現在のブック名 '受注データの開始行をチェック I = WorkStartRow '受注データの最終行をチェック Do Until ActiveCell.Value = "" I = I + 1 Cells(I, 1).Select Loop WorkEndRow = I - 1 '受注データをコピー Range(Cells(WorkStartRow, 1), Cells(WorkEndRow, DataMaxCol)).Select Selection.Copy 'workシートへペースト Windows(ThisBook).Activate Sheets(WorkSheetName1).Select Range("A1").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False '受注データファイルをクローズ Windows(LoadBook).Close End Sub このマクロを実行するとインデックスが有効範囲にありませんとなりエラーとなってしまいます。 あと最後のデータファイルをクローズできればOKなのですが・・。 どこがいけないんでしょうか？
- ベストアンサー
- Visual Basic
- Excel VBAの繰返し処理を教えて下さい
マクロを始めたばかりの初心者です。 どなたかご教示下さい。 リストから担当者社員番号をキーとして既定のシートにデータ転記し、別ファイルコピー後名前を付けて保存するというマクロを作成しています。 ご教示頂きたいのは、担当者別にファイルを作成したいのですが、 １行ごとの処理になり、無限ループでVBAが終了しません。 色々調べてみたものの、解決策が見つかりません。 どなたかご教示いただけないでしょうか。 読みにくいコードですが何卒よろしくお願い致します。 サンプルコード Sub 担当者用_個人用() Dim 行 As Integer Dim 年月 As String Dim メール行 As Integer Dim 担当者用 As String Dim 社員番号 As String Dim 社員名 As String Dim 残業対象 As String Dim 所属コード As String Dim 所属名 As String Dim 事業所コード As String Dim 事業所名 As String Dim 社員区分 As String Dim 平日時間外_m As String Dim 休日時間外_m As String Dim 時間外合計 As String Dim 前月時間外合計 As String Dim 前々月時間外合計 As String Dim 平均 As String Dim 問診票 As String Dim 削減書 As String Dim 担当者社員番号 As String Dim 担当者 As String Application.ScreenUpdating = False Sheets("個人用").Select 年月 = InputBox("ＯＴレポートの「年月」を入力してください 例：（前月）2012年9月 → 201209") Range("A2") = 年月 Sheets("健康診断問診票").Select 行 = 5 メール行 = 5 【こちらの繰返し処理が無限ループになっています。ご教示頂けないでしょうか】 Do Until Cells(行, 17).Value = "" If Cells(行, 17).Value <> 担当者社員番号 Then End If 出力処理: 社員番号 = Cells(行, 1).Value 社員名 = Cells(行, 2).Value 残業対象 = Cells(行, 3).Value 所属名コード = Cells(行, 4).Value 所属名 = Cells(行, 5).Value 事業所コード = Cells(行, 6).Value 事業所名 = Cells(行, 7).Value 社員区分 = Cells(行, 8).Value 平日時間外_m = Cells(行, 9).Value 休日時間外_m = Cells(行, 10).Value 時間外合計 = Cells(行, 11).Value 前月時間外合計 = Cells(行, 12).Value 前々月時間外合計 = Cells(行, 13).Value 平均 = Cells(行, 14).Value 問診票 = Cells(行, 15).Value 削減書 = Cells(行, 16).Value 担当者社員番号 = Cells(行, 17).Value 担当者 = Cells(行, 18).Value Sheets("個人用").Select Range("A5").Select Cells(メール行, 1).Value = 社員番号 Cells(メール行, 2).Value = 社員名 Cells(メール行, 3).Value = 残業対象 Cells(メール行, 4).Value = 所属名コード Cells(メール行, 5).Value = 所属名 Cells(メール行, 6).Value = 事業所コード Cells(メール行, 7).Value = 事業所名 Cells(メール行, 8).Value = 社員区分 Cells(メール行, 9).Value = 平日時間外_m Cells(メール行, 10).Value = 休日時間外_m Cells(メール行, 11).Value = 時間外合計 Cells(メール行, 12).Value = 前月時間外合計 Cells(メール行, 13).Value = 前々月時間外合計 Cells(メール行, 14).Value = 平均 Cells(メール行, 15).Value = 問診票 Cells(メール行, 16).Value = 削減書 Cells(メール行, 17).Value = 担当者社員番号 Cells(メール行, 18).Value = 担当者 '個別ファイル作成 Sheets("個人用").Select Sheets("個人用").Copy 年月 = Cells(2, "A") 担当者社員番号 = Cells(5, "Q") 担当者 = Cells(5, "R") Application.DisplayAlerts = False 'メッセージを出さない ActiveWorkbook.SaveAs Filename:="C:\担当者用\" & ("勤怠抽出" & 年月 & "(" & 担当者社員番号 & " " & 担当者 & "さん" & ")") & ".xls" ActiveWorkbook.Save ActiveWindow.Close Sheets("個人用").Select Rows("5:5").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Sheets("健康診断問診票").Select 行の終わり: 行 = 行 + 1 Loop Sheets("ファイル作成").Select Range("A30").Select ActiveWorkbook.Save Application.ScreenUpdating = True MsgBox "ファイル作成が終了しました" End Sub
- ベストアンサー
- その他MS Office製品
- エクセルVBAで困っています。
エクセルでSheet1でSheet2に各銀行の出納帳を作りそこから各項目ごとに別Sheetに振り分けたいと思っています。 ある方にエクセルVBAで作って頂いたのですが、最初作って頂いた時の項目は会費、会議費、事務費の３つでした。その項目を９つに増やしたいと思っています。又、全てのSheetで１行目には銀行名や項目名を入れたいので２行目から日付、内容・・・といったように入力したいです。そうした場合、どこをどう変更したらよいのか分かりません。自分がわかる範囲で（適当ですが）挑んでみたのですが、私自体VBAについて全く無知のため何が何だかサッパリです。どなたか教えて頂くことはできないでしょうか。ちなみに文字数に制限があったため改行やスペースなどは入れていません。見難いとは思いますがよろしくお願いします。どうか皆様のお知恵を貸して頂けると幸いです。 Option Explicit Sub Teller() '【考え方】Sheet1とSheet2を入力と考える。 'マクロを実行したときに、Sheet1,2を元に、項目別に振り分ける。 Const BankName1 As String = "○銀行" Const BankName2 As String = "(チェック)銀行" Const tempSheet As String = "一時シート" Dim classify(9) As String Dim title(5) As String Dim i As Long Dim j As Long Dim lastRow1 As Long Dim lastRow2 As Long Dim findUpper As Long Dim findLower As Long Dim keyword As String Dim ws As Worksheet Dim Bank1 As Worksheet Dim Bank2 As Worksheet Dim Temp As Worksheet Set Bank1 = Worksheets(BankName1) Set Bank2 = Worksheets(BankName2) '【振り分ける項目名】 classify(1) = "会費" classify(2) = "会議費" classify(3) = "事務費" classify(4) = "事業費" classify(5) = "研修費" classify(6) = "報償費" classify(7) = "慶弔費" classify(8) = "予備費" classify(9) = "積立金" '【1行目に記載する見出し】 title(1) = "日付" title(2) = "内容" title(3) = "収入" title(4) = "支出" title(5) = "残高" '画面更新を停止 Application.ScreenUpdating = False '最終行取得 Bank1.Select lastRow1 = Cells(Rows.Count, 1).End(xlUp).Row Bank2.Select lastRow2 = Cells(Rows.Count, 1).End(xlUp).Row 'シートを作る For i = 1 To 3 Call MakeNewSheet_As_ThisName(classify(i)) For j = 1 To 5 Cells(1, j) = title(j) Next j Next i Call MakeNewSheet_As_ThisName(tempSheet) Cells.ClearContents Set Temp = Worksheets(tempSheet) '一時シートに、銀行1のデータと銀行2のデータをコピーする。 Bank1.Select Bank1.Range(Cells(3, 1), Cells(lastRow1, 5)).Copy Temp.Select Temp.Range(Cells(1, 1), Cells(lastRow1 - 2, 5)).PasteSpecial Bank2.Select Range(Cells(3, 1), Cells(lastRow2, 5)).Copy Temp.Select Cells(lastRow1 - 1, 1).PasteSpecial 'ソートする。 '第一優先キー：B列。[項目]昇順。 '第二優先キー：A列。[日付]昇順。 Range("A1:E" & (lastRow1 + lastRow2 - 4)).Select With ActiveWorkbook.Worksheets(tempSheet).Sort .SortFields.Clear .SortFields.Add Key:=Range("B1:B" & (lastRow1 + lastRow2 - 4)), Order:=xlAscending '第一キー .SortFields.Add Key:=Range("A1:A" & (lastRow1 + lastRow2 - 4)), Order:=xlAscending '第二キー .SetRange Range("A1:E" & (lastRow1 + lastRow2 - 4)) .Apply End With For i = 1 To 3 keyword = classify(i) findUpper = 0 findLower = 0 '上から探す For j = 1 To lastRow1 + lastRow2 - 4 Step 1 If Cells(j, 2) = keyword Then findUpper = j Exit For End If Next j If findUpper > 0 Then '下から探す For j = lastRow1 + lastRow2 - 4 To 1 Step -1 If Cells(j, 2) = keyword Then findLower = j Exit For End If Next j 'コピー Range(Cells(findUpper, 1), Cells(findLower, 5)).Copy Sheets(keyword).Select Range("A2").Select ActiveSheet.Paste Range("B2:B" & 2 + (findLower - findUpper)).Delete Shift:=xlToLeft Sheets(tempSheet).Select End If Next i '一時シートの削除 Application.DisplayAlerts = False Temp.Delete Application.DisplayAlerts = True 'アクティブセルをA1にしておく For Each ws In Worksheets Sheets(ws.Name).Select 'シート選択 Application.CutCopyMode = False Range("A1").Select Next ws Bank1.Select '画面更新を行う Application.ScreenUpdating = True MsgBox "実行しました" End Sub Sub MakeNewSheet_As_ThisName(ByVal GivenName As String) 'シートの有無を確認し、無ければ作る Dim exist_flag As Boolean Dim ws As Worksheet exist_flag = False For Each ws In Worksheets If UCase(ws.Name) = UCase(GivenName) Then 'シートが存在する場合 exist_flag = True Exit For End If Next ws 'シートを作成 If GivenName = "" Then MsgBox "空白名のシートは作れません。" ElseIf exist_flag = False Then Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = GivenName End If Sheets(GivenName).Select 'シート選択 End Sub
- ベストアンサー
- オフィス系ソフト
- Excel vba 実行エラー1004
(1)アクティブブックの名前を取得してセルＯ２に貼り付けた。ex. 1234567ｂ.CSV (2)ＶＢＡを使って1234567ｋ.CSV におきかえた。 (3)(2)のセルに入力された内容でブックを開きたいが、エラー1004が出て開けない。 (4)開けたとして、そのブックのＡ１セルを 元のブックをアクティブにして Ｄ１に 貼り付けたい。 (5)またさっきのブックに戻ってＦ１セルを 元のブックをアクティブにして Ｅ１セルに貼り付けたい。 というようなＶＢＡを組みたいと思っています。 現在(1)(2)はできましたが(3)でエラーが出たため止まっていますし、その後もわかりません。 Dim bb As String Dim kb As String bb = ActiveWorkbook.Name Cells(2, "O").Value = ActiveWorkbook.Name Cells(3, "O").Value = ActiveWorkbook.Name Range("O2").Formula = Replace(bb, "b.CSV", "k.CSV") kb = Range("O2") 'シート名を取得する Dim bbs As String bbs = Left(bb, 10) Cells(4, "O").Value = bbs Dim kbs As String kbs = Left(kb, 10) Cells(5, "O").Value = kbs 'コピーして貼り付ける kbn = Cells(2, 15) Workbooks.Open Filename:=kbn Range("F1").Select Range("F1").Copy として作ってるんですが、 Workbooks.Open Filename:=kbn でエラーが出てブックが開けません。 ご指導お願いします。
- ベストアンサー
- オフィス系ソフト
- VBA 実行時エラー1004(その2)
毎度お世話になっております。 シート「sheet2」のA列のリスト内容を、シート「M_得意先」のリストからVLOOKUPして、指定のセルに書き出していくというコードを作成してみたのですが、VLOOKUPを実行する段階でエラーが出てしまいます。 少し変更して、同一シート内でのVLOOKUPは問題なく実行できたのですが...原因をご存知の方教えてください。 Dim b As String Dim endRcell2 As Long Dim cnt10 As long Sheets("sheet2").Select Sheets("sheet2").Range("A1").CurrentRegion.Select 'データ全体選択 Selection.SpecialCells(xlCellTypeLastCell).Select '最終行検出 endRcell2 = ActiveCell.Row cnt10 = 2 Do ↓実行時エラー1004が出る行 b = Application.WorksheetFunction.VLookup(Sheets("Sheet2").Range("A" & cnt10).Value, Sheets("M_得意先").Range(Cells(1, 1), Cells(endRcell, 2)), 2, False) ↑実行時エラー1004が出る行 Sheets("sheet2").Range("E" & cnt10).Value = b cnt10 = cnt10 + 1 Loop Until cnt10 = endRcell2
- ベストアンサー
- その他MS Office製品
- もしフォルダがなかったら作成するというコード
エクセルvbaで、 フォルダA（FileA）の中のPDFファイル全部を、フォルダB（FileB）へコピーする というコードを作成しました。 が、パスが見つかりませんとエラーが出ます。 その理由は、移動先にフォルダがないからです。 フォルダがない場合は、フォルダを作成するというコードを入れたいのですが、 もしご存知の方いらっしゃいましたら、どうか教えてください。 エクセル2010ｄを使用しています。 vba初心者で、ここまでネット検索などで作りましたので、いびつかもしれません。 どうぞよろしくお願いいたします。 ---------------------------------- Sub CopyPDFwithFile() 'フォルダ内のPDFを全てAをBへコピー Dim objFileSys As Object Dim strScriptPath As String Dim strCopyFrom As String Dim strCopyTo As String Dim MaxRow As Integer Dim i As Long Dim k As Long Dim FileA, FileB As String n = Range("V6").Value MaxRow = ThisWorkbook.Sheets(n).Cells(11, 22).End(xlDown).Row For i = 1 To MaxRow - 10 FileA = Range("V" & i + 10).Value FileB = Range("W" & i + 10).Value Debug.Print FileA Debug.Print FileB Set objFileSys = CreateObject("Scripting.FileSystemObject") strScriptPath = ThisWorkbook.Path Debug.Print strScriptPath strCopyFrom = objFileSys.BuildPath(FileA, ".pdf") strCopyTo = objFileSys.BuildPath(FileB, "new\.pdf") objFileSys.CopyFile FileA & "\*.pdf", FileB '←ここでエラー、ストップします Set objFileSys = Nothing Next i End Sub ---------------------------------------------
- ベストアンサー
- Excel（エクセル）
- ＶＢＡ超初心者です
皆さんのお知恵を拝借させてください。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2007/12/1 ユーザー名 : 101 ' Dim pearend As Integer Dim code As Integer Dim codeend As Integer Dim sheet_name As String Dim dayend As Date Sheets("商品名").Select Range("A4").Select Selection.End(xlDown).Select pearend = Selection.Row() For l = 4 To pearend Step 2 For r = 2 To 3 Cells(l, r).Select code = Cells(l, r).Value Select Case code Case 1000 To 1999 sheet_name = "1000" Case 2000 To 2999 sheet_name = "2000" Case 3000 To 3999 ssheet_name = "3000" Case 4000 To 4999 sheet_name = "4000" Case 5000 To 5999 sheet_name = "5000" End Select Sheets(sheet_name).Select Range("B4").Select Selection.End(xlToRight).Select codeend = Selection.Column() Range("A5").Select Selection.End(xlDown).Select dayend = Selection.Row() For i = 2 To codeend If code = Cells(4, i).Value Then Range(Cells(dayend, i), Cells(5, i)).Select Selection.Copy Sheets("商品名").Select Range("K3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next Next Next End Sub というマクロをつくってみたのですが、何順目かあたりから For r = 2 To 3 のｒがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。
- ベストアンサー
- オフィス系ソフト
- excel vba で 実行時エラー13となります。
こんにちは、 先日、「作りながら覚える！ excel vba マクロ 組み方講座 永井善王著」という本を購入してvbaマクロを勉強中です。 本にそって進めていくと、P.122の所でストップしてしまいました。 急に「実行時エラー13 型が一致しません」と表示され、何回やりなおしてもそこから進めなくなりました。 コードは、 Sub DBシートから当月分シートを作成する() Dim 開始年月日 As Long Dim 終了年月日 As Long 開始年月日 = ">=" & Worksheets("年月日入力").Range("D4") 終了年月日 = "<=" & Worksheets("年月日入力").Range("D5") ChDir "C:\ときめき" Workbooks.Open Filename:="C:\ときめき\売上DB.xls" Sheets("当月分").Select Cells.Select Selection.Clear Sheets("DB").Select Range("A2").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:=開始年月日, _ Operator:=xlAnd, Criteria2:=終了年月日 Selection.CurrentRegion.Select Selection.Copy Sheets("当月分").Select Range("A1").Select ActiveSheet.Paste Sheets("DB").Select Application.CutCopyMode = False Selection.AutoFilter Sheets("住所録").Select ActiveWorkbook.Save ActiveWindow.Close End Sub になります。 3行目の 開始年月日 = ">=" & Worksheets("年月日入力").Range("D4") が黄色くなっています。 （なぜかこの本では、Dim As Long での変数定義がされておらず、そこは自分で入れています。） 現在本に沿って勉強しているところですが、詰まってしまいお手上げの状態です。 どうぞ助けてくださいませ。
- ベストアンサー
- オフィス系ソフト
- エクセル ＶＢＡ シートの選択
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のところが黄色くなります。 何処が間違えているのでしょうか。 全くの素人ですが、仕事で必要に迫られています。 わかりやすく回答・解説くれると助かります。
- ベストアンサー
- オフィス系ソフト
- Excel VBAの「FOR～NEXT関数」について
VBAを初めて2ヶ月の超初心者です。 シートが2枚あり、sheet1は仕入金額一覧、sheet2は送付案内書になっています。VBAを利用して「sheet1から1行、sheet2へ転記し印刷後、次の行へ」と言う処理をしています。 Sub 送付案内() Dim 行番号 As Integer For 行番号 = 5 To 298 If Cells(行番号, 15).Value = 1 Then Range(Cells(行番号, 2), Cells(行番号,12).Select Selection.Copy Sheets("送付案内").Select Range(Cells(60, 1), Cells(60, 11)).Select ActiveSheet.Paste Application.CutCopyMode = False Worksheets("送付案内").PrintOut Sheets("作業").Select End If Next End Sub Sub 仕入先名() Dim 行番号 As Integer For 行番号 = 5 To 298 Sheets("作業").Cells(行番号, 2) = WorksheetFunction.VLookup(Cells(行番号, 1), Sheets("仕入先マスタ"). _ Range("$A$3:$B$1135"), 2, False) Next End Sub これでVBAを実行した場合、仕入金額一覧の並び順と微妙(2～3点）に異なる順番で印刷されました。仕入先名や仕入金額に間違いはありませんでした。 同様の経験のある方等、原因がわかる方がいらしたら、教えてください。よろしくお願いします。
- ベストアンサー
- その他MS Office製品
お礼
問題が解消されました 他の仕組みと競合しておりました ありがとうございました
補足
ご回答ありがとうございます。 ご指摘いただいた箇所を修正してもまだ落ちてしまいます。 追加で Workbooks("test.xlsm").Activate Sheets("02").Select Sheets("02").Cells.Select とシートをアクティブにしても落ちる状態です。