• 締切済み

CSV取り込み&集計

'***************************************************************** ' 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 = Null 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 Sub 売上() ' Call CSV取り込み Range("K3:K19").Select Selection.Copy Sheets("売上").Select Range("K3:K19").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 上記のようなプログラムを書いているのですが何度もはじかれてしまいます。何が原因なのかいまいちよくわからないのですがVBAに詳しい方助けてもらえませんでしょうか?

  • hosoo
  • お礼率54% (12/22)

みんなの回答

  • Kame_LABO
  • ベストアンサー率24% (30/122)
回答No.3

はじかれたときに、WorkSheetName1にマウスを当てると、中身に何が入っているか分かると思います。(VBの機能でVBAには無かったかな?) もしくは、 Debug.Print WorkSheetName1 としてイミディエイトウインドウに中身を表示させてください。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

Sub test01() a = 22 End Sub Sub test02() Call test01 MsgBox a End Sub test02を実行すると、a は空白と表示される。 Publicなどの宣言が無い。 この類の誤りは大丈夫ですか。

  • Kame_LABO
  • ベストアンサー率24% (30/122)
回答No.1

どこではじかれますか? どこまでは動きますか? デバッグの力も身につけましょう。

hosoo
質問者

補足

'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

関連する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なのですが・・。 どこがいけないんでしょうか?

  • エクセル VBA シートの選択 

    windows XP でエクセル2000を使っています。 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超初心者です

    皆さんのお知恵を拝借させてください。 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 のrがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。

  • マクロの処理速度が遅くなってしまいました

     今までエクセル2000を使用していたのですが、エクセル2003にバージョンアップして、以下の処理速度を検証したところ、処理が遅くなってしまいました。内容はsheet2にあるデータを変数に格納して簡単な計算をした後にsheet1に入力するということを5回繰り返し、それぞれの処理にかかる時間をsheet3に表示するというものです。 Sub タイム計測()   Dim myStart As Single, myGoal As Single   Dim j As Integer   Application.ScreenUpdating = False   Sheets(1).Select   Cells.Clear     For j = 1 To 5       myStart = Timer         Call サンプル       myGoal = Timer - myStart       Sheets(3).Select       Cells(j, 1) = myGoal       Sheets(1).Select     Next     Sheets(3).Select   Application.ScreenUpdating = True End Sub Sub サンプル()   Dim i As Integer, j As Integer   Dim Data As Variant, KeKKa(1 To 2000, 1 To 199) As Variant   Data = Range(Sheets(2).Cells(1, 1), Sheets(2).Cells(2000, 199))   For i = 1 To 2000     For j = 1 To 199       KeKKa(i, j) = Data(i, j) + Data(i, j)     Next   Next   Range(Cells(1, 1), Cells(2000, 199)) = KeKKa End Sub エクセル2000のときは1回当り平均して概ね0.7秒位で処理していたのですが、エクセル2003にすると1.4秒位かかってしまいます。処理速度が遅くなってしまうとバージョンアップした意味がないのですが、原因や改善策があればどなたか教えていただけないでしょうか?よろしくお願いします。

  • 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 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点)に異なる順番で印刷されました。仕入先名や仕入金額に間違いはありませんでした。 同様の経験のある方等、原因がわかる方がいらしたら、教えてください。よろしくお願いします。

  • 行列入れ替えの並び替えを簡単に出来る方法

    エクセルで写真の左側のシートを右側のシートの様に並び替えをしたいのですが、簡単に計算式を入れてやる方法はありますか? 変換前のシートは他にもありまして、行列の長さはどれも長さがバラバラになっております。 行は~◯kgが複数あり、列は商品コードが100個以上あるのもあります。 なので、行列の長さがバラバラでも一つのマクロで動作出来るものを作成したいと考えています。 計算式を一個づつ入れて作ってましたがとんでもなく不格好になり。。。。 すみません、どなたかご指導お願いできませんか? Sub henkan() '貼付けシートの作成 'シート名は変換で作成 Sheets.Add after:=ActiveSheet ActiveSheet.Name = "変換" 'タイトル名作成 Range("A1").Select ActiveCell.FormulaR1C1 = "商品コード" Range("B1").Select ActiveCell.FormulaR1C1 = "容量" Range("C1").Select ActiveCell.FormulaR1C1 = "量" '容量作成 Dim g As Integer Dim h As Integer r = 0 Z = 0 y = 0 Worksheets("量").Activate Range(Cells(3, 3), Cells(3, Columns.Count).End(xlToLeft)).Select Z = Selection.Count Worksheets("量").Activate Range("B4", Range("B4").End(xlDown)).Select y = Selection.Rows.Count For g = 4 To y + 3 Worksheets("量").Activate Range(Cells(3, 3), Cells(3, Columns.Count).End(xlToLeft)).Select Selection.Copy h = g - 2 + r 'ここでhの値を計算しています Sheets("変換").Cells(h, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True r = r + Z - 1 Next g '量作成 Dim j As Integer Dim k As Integer r = 0 For j = 4 To y + 3 Sheets("量").Select Sheets("量").Range(Cells(j, 3), Cells(j, Columns.Count).End(xlToLeft)).Copy k = j - 2 + r 'ここでkの値を計算しています Sheets("変換").Cells(k, 3).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True r = r + Z - 1 Next j '商品コード作成 Dim l As Integer Dim m As Integer r = 0 For l = 4 To y + 3 Worksheets("量").Activate Cells(l, 2).Select Selection.Copy m = l - 2 + r 'ここでmの値を計算しています Sheets("変換").Cells(m, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True r = r + Z - 1 Next l '罫線作成 Sheets("変換").Select With ActiveSheet.UsedRange.Borders .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With '容量コードの空白埋め Sheets("変換").Select Range("A1").Select Dim o As String Dim p As Range o = "A2:B" & Range("C" & Format(Rows.Count)).End(xlUp).Row For Each p In Range(o) If p.Value = "" Then p.Value = p.Offset(-1, 0).Value Next Dim rng As Range Worksheets("変換").Activate Worksheets("変換").UsedRange.Select For Each rng In Selection If rng.Value = "" Then rng.Value = "0" End If Next rng End Sub

  • 連続印刷について

    顧客名簿を作成し連続印刷により、市販されているようなアドレス帳の レイアウトで印刷したいのですが、以下の様に13人分の印刷をすると 次の連続印刷では1つ繰り上がって、印刷されるだけとなってしまいました。 次ページの印刷からは、14行めから更にその次では28行目からと 印刷設定をしたいのですが、どうすれば宜しいのでしょうか? 別シートに印刷用のレイアウトをVLOOKUPで作成し、更に別シートで印刷設定を行っています。 初心者なりに見よう見まねで作ってみたのですが・・・・ 説明が下手で分かりにくく申し訳ありません。 護教授宜しくお願い致します。 Sub 連続印刷1() ' Dim mycounter As Integer Dim sita1 As Integer Dim migi1 As Integer mycounter = 1 sita1 = Sheets("設定").Cells(4, 2) migi1 = Sheets("設定").Cells(5, 2) For mycounter = 1 To 5 Sheets("顧客名簿").Select Range("O2").Value = Sheets("住所録").Cells(mycounter + 1, 1) Range("O6").Value = Sheets("住所録").Cells(mycounter + 2, 1) Range("O10").Value = Sheets("住所録").Cells(mycounter + 3, 1) Range("O14").Value = Sheets("住所録").Cells(mycounter + 4, 1) Range("O18").Value = Sheets("住所録").Cells(mycounter + 5, 1) Range("O22").Value = Sheets("住所録").Cells(mycounter + 6, 1) Range("O26").Value = Sheets("住所録").Cells(mycounter + 7, 1) Range("O30").Value = Sheets("住所録").Cells(mycounter + 8, 1) Range("O34").Value = Sheets("住所録").Cells(mycounter + 9, 1) Range("O38").Value = Sheets("住所録").Cells(mycounter + 10, 1) Range("O42").Value = Sheets("住所録").Cells(mycounter + 11, 1) Range("O46").Value = Sheets("住所録").Cells(mycounter + 12, 1) Range("O50").Value = Sheets("住所録").Cells(mycounter + 13, 1) Range(Cells(1, 1), Cells(sita1, migi1)).Select Selection.PrintOut Copies:=Sheets("設定").Cells(6, 2) Next ' End Sub

  • エクセルVBAでのCSV出力方法について

    エクセルVBAを使ってCSVを出力しようとしているのですが、 狙った範囲を上手くCSV化することが出来ずに苦戦しています。 どなたかアドバイスを頂けませんでしょうか。 使用してるエクセルは2010になります。 シート2のコマンドボタンを押すことでシート1の内容をCSV化したいと考えています。 シート1のA1に入力した内容がCSVのタイトルになります。 2行目はヘッダーですが、CSVには反映しないように制御をかけています。 ↓が実際に書いてみたVBAですが、どうしてもシート1の内容を持ってきてしまいます。 どのように改修したらシート2の内容を持ってこれるでしょうか。 Private Sub CommandButton1_Click() Dim MyFile, FileType, Prompt As String Dim FileNamePath As Variant Dim StartRow, StartCol, EndRow, EndCol As Integer Dim Rowcnt, Colcnt As Integer Dim UsedCell As Range Dim ch1 As Long '対象のシートをアクティブにする Worksheets("シート1").Activate 'ファイル名の取得 MyFile = ActiveSheet.Range("A1") & ".csv" FileType = "CSV ファイル (*.csv),*.csv" Prompt = "保存するファイルの名前を付けてください" '保存するファイルのパスを取得します FileNamePath = SaveFileNamePath(MyFile, FileType, Prompt) If FileNamePath = False Then 'キャンセルボタンが押された End End If '空いているファイル番号を取得します ch1 = FreeFile 'FileNamePath のファイルをオープンします Open FileNamePath For Output As #ch1 '使用しているセルの取得 Set UsedCell = ActiveSheet.UsedRange StartRow = UsedCell.Cells(3).row StartCol = UsedCell.Cells(1).Column EndRow = UsedCell.Cells(UsedCell.Count).row EndCol = UsedCell.Cells(UsedCell.Count).Column For Rowcnt = StartRow To EndRow For Colcnt = StartCol To EndCol - 1 '改行を挿入しないで書き出す ; を最後に付ける Write #ch1, Cells(Rowcnt, Colcnt); Next '改行を挿入する Write #ch1, Cells(Rowcnt, EndCol) Next 'ファイルを閉じます Close #ch1 End Sub Function SaveFileNamePath(MyFile, FileType, Prompt) As Variant SaveFileNamePath = Application.GetSaveAsFilename(MyFile, FileType) End Function アドバイスを頂けたらと思います。 どうぞ宜しくお願いします。

  • エクセルに入力されたアンケートの回答をマクロで集計する。

    画像をアップしたので、こちらを見ていただくと分かりやすいと思いますが、同一フォルダの中に、あるアンケートに対する回答のエクセルファイル(全く同じ形式でだが、ブックの名前に規則性はない)があり、別の場所にその回答を一覧に並べるための"集計用ファイル"がります。このアンケートの回答ファイルは日々数が追加されて行くので、毎日"集計用ファイル"に回答を得た分を転記し日付の名前でもつけて保存して行きたいのです。エクセルマクロを使用して、この"Book1"~"BookXXX"の特定の部分に入力された内容を一人一列となるように"集計用ファイル"のB列から右へ右へと転記したいと考えています。 下記、内容を簡単にしたサンプルを作り、VBAを書いてはみたものの、やはり動きませんでした。(セルは例として3つのみ転記しようとしています) 関連する質問もこちらにさせて頂いたのですが、まだ独力で解決できず再度投稿させて頂きました。よろしくお願いいたします。 Sub 転記() Dim WorkPath As String Dim Target As String Dim MaxRow As Long Application.ScreenUpdating = False WorkPath = "C:\Documents and Settings\Zawa\デスクトップ\Test" Target = Dir(WorkPath & "\*.xls", vbNormal) MaxRow = 1 Do While Target <> "" Workbooks.Open WorkPath & "\" & Target Workbooks(Target).Sheets("Sum").Select Range("C7").Select Selection.Copy ThisWorkbook.Sheets("Sheet1").Select Range("B3").Select ActiveSheet.Paste Workbooks(Target).Sheets("Sum").Select Range("C10").Select Application.CutCopyMode = False Selection.Copy ThisWorkbook.Sheets("Sheet1").Select Range("B4").Select ActiveSheet.Paste Workbooks(Target).Sheets("Sum").Select Range("D10").Select Application.CutCopyMode = False Selection.Copy ThisWorkbook.Sheets("Sheet1").Select Range("B5").Select ActiveSheet.Paste Workbooks(Target).Close SaveChanges:=False Target = Dir() Loop MsgBox "転記が終了しました。" End Sub

専門家に質問してみよう