VBAでタブ区切りファイルを列区切りにしたい

このQ&Aのポイント
  • VBAで秀丸のテキストファイルをエクセルに読み込むとき、タブ区切りがエクセルでは連続した文字列になってしまいます。これを列に区切って読み込みたいのですがどうしたらいいですか?
  • 使用するプログラムは、「Excelでお仕事!」のサンプルを使ったもので、ファイルを開く画面から選択する形です。コードは下記です。
  • VBAでタブ区切りファイルを列区切りにする方法について教えてください。タブ区切りのファイルをエクセルに読み込むとき、連続した文字列になってしまうため、列に区切って読み込みたいです。使用するプログラムは「Excelでお仕事!」のサンプルで、ファイルを開く画面から選択する形です。コードは以下の通りです。
回答を見る
  • ベストアンサー

VBAでタブ区切りファイルを列区切りにしたい

VBAで秀丸のテキストファイルをエクセルに読み込むとき、タブ区切りがエクセルでは連続した文字列になってしまいます。 これを列に区切って読み込みたいのですがどうしたらいいですか? 読み込むプログラムは、「Excelでお仕事!」のサンプルを使ったもので、ファイルを開く画面から選択する形です。コードは下記です。 ' Applicationオブジェクト取得 Set xlAPP = Application ' (1) ' 「ファイルを開く」のフォームでファイル名の指定を受ける xlAPP.StatusBar = "読み込むファイル名を指定して下さい。" strFILENAME = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, _ Title:=cnsTITLE) ' (2) ' キャンセルされた場合は以降の処理は行なわない If StrConv(strFILENAME, vbUpperCase) = "FALSE" Then Exit Sub ' (3) ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' (4) ' 指定ファイルをOPEN(入力モード) Open strFILENAME For Input As #intFF ' (5)

noname#157810
noname#157810

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

  • ベストアンサー
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

Sub の上に Option Base 1 を追加。 Dim v を宣言して ' 行を加算しA列にレコード内容を表示(先頭は2行目) v = Split(strREC, vbTab) GYO = GYO + 1 Cells(GYO, 1).Resize(, UBound(v) + 1).Value = v に変更 ではどうでしょうか?

noname#157810
質問者

お礼

早速のご回答ありがとうございます。 例示されたコードをそのまま使うことができなかったのですが、 SplitとUBoundを使えば良いことがわかったので、それらを使って解決しました。 助かりました。お世話になりました。

関連するQ&A

  • VBAでCSVを文字列として取り込む方法

    VBAでCSVを文字列として取り込む方法を教えてください。 下記のようにCSVファイルを取り込んでいます。 Array関数を使用していますが、どうしても文字列として認識してくれません。 Sub CSV取り込み() Dim xlAPP As Application ' Applicationオブジェクト Dim strFILENAME As String ' OPENするファイル名(フルパス) 'Applicationオブジェクト取得 Set xlAPP = Application '「ファイルを開く」のフォームでファイル名の指定を受ける xlAPP.StatusBar = "読み込むファイル名を指定して下さい。" strFILENAME = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, Title:=cnsTITLE) 'キャンセルされた場合は以降の処理は行なわない If StrConv(strFILENAME, vbUpperCase) = "FALSE" Then Exit Sub Workbooks.OpenText Filename:=strFILENAME, _ DataType:=xlDelimited, comma:=True, _ fieldinfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), _ Array(4, 2), Array(6, 2)) Workbooks.Open Filename:=strFILENAME ActiveWorkbook.Sheets(1).Cells.Copy _ Destination:=ThisWorkbook.Worksheets("sheet1").Range("A1") End Sub この書式ではCSVを文字列として取り込めないのでしょうか? どなた様かご教示ください。 よろしくお願いいたします。

  • VBAでのテキストデータ追記

    VBAを使ってデータをテキストファイルに追記したいのですが、 A列だけじゃなく A列からF列までのデータを追記させたいと 考えているのですが、 どうやるのか理解できません。 教えていただけますでしょうか? -------------------------------------------------------------- Option Explicit ' テキストファイル書き出すサンプル Sub WRITE_TextFile() Const cnsTitle = "テキストファイル出力処理" Const cnsFilter = "テキストファイル (*.txt;*.dat),*.txt;*.dat" Dim xlAPP As Application ' Applicationオブジェクト Dim intFF As Integer ' FreeFile値 Dim strFileName As String ' OPENするファイル名(フルパス) Dim vntFileName As Variant ' ファイル名受取り用 Dim strREC As String ' 書き出すレコード内容 Dim GYO As Long ' 収容するセルの行 Dim GYOMAX As Long ' データが収容された最終行 Dim lngREC As Long ' レコード件数カウンタ ' Applicationオブジェクト取得 Set xlAPP = Application ' 「名前を付けて保存」のフォームでファイル名の指定を受ける xlAPP.StatusBar = "出力するファイル名を指定して下さい。" ' (1) vntFileName = xlAPP.GetSaveAsFilename(InitialFilename:="SAMPLE.txt", _ FileFilter:=cnsFilter, _ Title:=cnsTitle) ' キャンセルされた場合はFalseが返るので以降の処理は行なわない If VarType(vntFileName) = vbBoolean Then Exit Sub strFileName = vntFileName ' 収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す) With ActiveSheet If .FilterMode Then .ShowAllData ' オートフィルタ解除 End With GYOMAX = Cells(65536, 1).End(xlUp).Row ' (2) If GYOMAX < 2 Then xlAPP.StatusBar = False MsgBox "テキストをA列2行目から入力してから起動して下さい。", , cnsTitle Exit Sub End If ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' 指定ファイルをOPEN(出力モード) Open strFileName For Output As #intFF ' (3) ' 2行目から開始 GYO = 2 ' 最終行まで繰り返す Do Until GYO > GYOMAX ' A列内容をレコードにセット(先頭は2行目) strREC = Cells(GYO, 1).Value ' (4) ' レコード件数カウンタの加算 lngREC = lngREC + 1 xlAPP.StatusBar = "出力中です....(" & lngREC & "レコード目)" ' レコードを出力 Print #intFF, strREC ' (5) ' 行を加算 GYO = GYO + 1 Loop ' 指定ファイルをCLOSE Close #intFF xlAPP.StatusBar = False ' 終了の表示 MsgBox "ファイル出力が完了しました。" & vbCr & _ "レコード件数=" & lngREC & "件", vbInformation, cnsTitle End Sub -----------------------------------------------------------------------------

  • エクセルのCSV読み込みについて

    現在,以下の記述でエクセル上にマクロ実行ボタンを作成しました。 任意のCSVファイルをエクセルに取り込み利用する目的です。 実行ボタンを押すと,「実行時エラー ファイルにこれ以上データがありません。」として,記述中の 「Input #intFF, X(1), X(2), X(3), X(4), X(5), X(6), X(7) ' (2)」 部分が黄色になって止まってしまいます。 エクセル画面上には,希望通りのデータが出力されているようなので,このエラーが表示されなければデータの取り込みとしては問題ないのですが・・・。 どのようにこのエラーを回避し処理すればよいかかが分かりません。 どなたかご教示いただければ幸いです。 どうかよろしくお願いいたします。 Sub Macro4() ' CSV形式テキストファイル(7カラム)読み込みサンプル Const cnsTITLE = "テキストファイル読み込み処理" Const cnsFILTER = "CSV形式ファイル (*.csv),*.csv,全てのファイル(*.*),*.*" Dim xlAPP As Application ' Applicationオブジェクト Dim intFF As Integer ' FreeFile値 Dim strFileName As String ' OPENするファイル名(フルパス) Dim vntFileName As Variant ' ファイル名受取り用 Dim X(1 To 7) As Variant ' 読み込んだレコード内容 ' (1) Dim GYO As Long ' 収容するセルの行 Dim lngREC As Long ' レコード件数カウンタ ' Applicationオブジェクト取得 Set xlAPP = Application ' 「ファイルを開く」のフォームでファイル名の指定を受ける xlAPP.StatusBar = "読み込むファイル名を指定して下さい。" vntFileName = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, _ Title:=cnsTITLE) ' キャンセルされた場合はFalseが返るので以降の処理は行なわない If VarType(vntFileName) = vbBoolean Then Exit Sub strFileName = vntFileName ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' 指定ファイルをOPEN(入力モード) Open strFileName For Input As #intFF GYO = 1 ' ファイルのEOF(End of File)まで繰り返す Do Until EOF(intFF) ' レコード件数カウンタの加算 lngREC = lngREC + 1 xlAPP.StatusBar = "読み込み中です....(" & lngREC & "レコード目)" ' レコードを読み込む(このサンプルは7項目のCSV) Input #intFF, X(1), X(2), X(3), X(4), X(5), X(6), X(7) ' (2) ' 行を加算しA~G列にレコード内容を表示(先頭は2行目) GYO = GYO + 1 Range(Cells(GYO, 1), Cells(GYO, 7)).Value = X ' 配列渡し ' (3) Loop ' 指定ファイルをCLOSE Close #intFF xlAPP.StatusBar = False ' 終了の表示 MsgBox "ファイル読み込みが完了しました。" & vbCr & _ "レコード件数=" & lngREC & "件", vbInformation, cnsTITLE End Sub

  • Excel VBA読み込みで文字化けが

    Excel VBAにてメールデータを読み込むプログラムを組んでいます。 データの作り方は、 (1)Mozilla Thunderbirdでメールデータをtext形式で保存 (2)VBAにてtextデータを開く。 しかし読み込みを行うと、文字化けしたデータが表示されてしまいます。 どのように解決したらよいのでしょうか? 文字コード変換を行ってもダメでした。 Sub Read_mail_data() Const cnsTITLE = "テキストファイル読み込み処理" Const cnsFILTER = "全てのファイル (*.*),*.*" Dim xlAPP As Application ' Applicationオブジェクト Dim intFF As Integer ' FreeFile値 Dim strFileName As String ' OPENするファイル名(フルパス) Dim vntFileName As Variant ' ファイル名受け取り用 Dim strREC As String ' 読み込んだレコード名 Dim GYO As Long ' 収容するセルの行 Dim lngREC As Long ' レコード件数カウンタ ' Applicationオブジェクト取得 Set xlAPP = Application ' 「ファイルを開く」のダイアログでファイル名の指定を受ける xlAPP.StatusBar = "読み込むファイル名を指定して下さい。" vntFileName = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, Title:=cnsTITLE) ' キャンセルされた場合はFalseが返るので以降の処理は行わない If VarType(vntFileName) = vbBoolean Then Exit Sub strFileName = vntFileName ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' 指定ファイルをOPEN(入力モード) Open strFileName For Input As #intFF GYO = 1 ' ファイルのEOF(End of File)まで繰り返す Do Until EOF(intFF) ' レコード件数カウンタの加算 lngREC = lngREC + 1 xlAPP.StatusBar = "読み込み中です....(" & lngREC & "レコード目)" ' 改行までをレコードとして読み込む Line Input #intFF, strREC ' 行を加算しA列にレコード内容を表示(先頭は2行目) GYO = GYO + 1 ' 文字コードを変換する 'StrConv(strREC, vbFromUnicode) = a Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode) ' セルにデータを書き込む 'Cells(GYO, 1).Value = strREC Loop ' 指定ファイルをCLOSE Close #intFF xlAPP.StatusBar = False ' 終了の表示 MsgBox "ファイル読み込みが完了しました。 " & vbCr & "レコード件数=" & lngREC & "件", vbInformation, cnsTITLE End Sub

  • VBAの初心者でやりたいことがあるのですが、どうやっていいのか分かりま

    VBAの初心者でやりたいことがあるのですが、どうやっていいのか分かりません。 やりたいことは 1.フォルダを指定してCSVファイルを読み込む。 2.読み込んだCSVファイルを一行あたり1ファイルのエクセルファイルに書き込む。 3.完成したエクセルファイルを印刷する。 4.フォルダの中のファイルが無くなれば終了 としたいのですが、途中で頓挫しています。 宜しくお願いします。 Option Explicit sub READ_TextFile() Const cnsTITLE = "フォルダ内のファイル名一覧取得" Const cnsDIR = "\*.*" Dim xlAPP As Application Dim strPATHNAME As String Dim strFILENAME As String Dim GYO As Long Const cnsFILTER = "全てのファイル (*.*),*.*" Dim xlAPP2 As Application' Applicationオブジェクト Dim intFF As Integer' FreeFile値 Dim X() As Variant' 読み込んだレコード内容 Dim IX1 As Long' CSV項目カラムINDEX Dim lngREC As Long' レコード件数カウンタ Dim strREC As String' レコード領域 Dim POS1 As Long' レコード文字位置 Dim POS2 As Long' レコード文字位置 Set xlAPP = Application strPATHNAME = xlAPP.InputBox("フォルダ名を入力して下さい。", _ cnsTITLE, "C:\Documents and Settings\hidekazu_miyawaki\デスクトップ\") If StrConv(strPATHNAME, vbUpperCase) = "FALSE" Then Exit Sub If Dir(strPATHNAME, vbDirectory) = "" Then MsgBox "指定のフォルダは存在しません。", vbExclamation, cnsTITLE Exit Sub End If strFILENAME = Dir(strPATHNAME & cnsDIR, vbNormal) Set xlAPP2 = Application Do While strFILENAME <> "" GYO = GYO + 1 Cells(GYO, 1).Value = strFILENAME strFILENAME = Dir() Open strFILENAME For Input As #intFF GYO = 1 Do Until EOF(intFF) lngREC = lngREC + 1 xlAPP2.StatusBar = "読み込み中です(" & lngREC & "レコード目)" Line Input #intFF, strREC POS1 = 1 IX1 = 0 ReDim X(IX1) Do While POS1 <= Len(strREC) POS2 = InStr(POS1, strREC, ",", vbTextCompare) If POS2 < POS1 Then POS2 = Len(strREC) + 1 End If ReDim Preserve X(IX1) X(IX1) = Trim$(Mid$(strREC, POS1, POS2 - POS1)) If (((Left$(X(IX1), 1) = """") And (Right$(X(IX1), 1) = """")) Or _ ((Left$(X(IX1), 1) = "'") And (Right$(X(IX1), 1) = "'"))) Then X(IX1) = Trim$(Mid$(X(IX1), 2, Len(X(IX1)) - 2)) End If POS1 = POS2 + 1 IX1 = IX1 + 1 Loop GYO = GYO + 1 If IX1 >= 1 Then Range(Cells(GYO, 1), Cells(GYO, IX1)).Value = X End If Loop Loop Close #intFF xlAPP.StatusBar = False MsgBox "ファイル読み込みが完了しました。" & vbCr & _ "レコード件数=" & lngREC & "件", vbInformation, cnsTITLE End Sub

  • CSVファイルをインポートするマクロについて

    CSVファイルをインポートするマクロを作成しようと思っているのが、作り方がわかりません。 アドバイスを下さい。 インポートするCSVの書式 "AAA","CC","DFD" "BBB","FF","HHH" "JJ","LL","JI" "Skip" "A","Y","JI","Y","JI" "B","L","JI","JI" "C","IL","JI" 1~3行目はエクセルのD3行,D4行,D5行 4行目はインポートしない 5行目以降はエクセルのA6行,A7行・・・にインポートしたいと思っております。 サンプルを作成して頂けないでしょうか。 下記のソースを元に作成しようとしているのですが、わからなくなってしまいました。 ◆作成途中のソース Sub READ_TextFile() Const cnsTitle = "テキストファイル読み込み処理" Const cnsFilter = "CSV形式ファイル (*.csv),*.csv" Dim xlAPP As Application ' Applicationオブジェクト Dim intFF As Integer ' FreeFile値 Dim strFileName As String ' OPENするファイル名(フルパス) Dim vntFileName As Variant ' ファイル名受取り用 Dim X() As Variant ' 読み込んだレコード内容 Dim IX1 As Long ' CSV項目カラムINDEX Dim GYO As Long ' 収容するセルの行 Dim lngREC As Long ' レコード件数カウンタ Dim strREC As String ' レコード領域 Dim POS1 As Long ' レコード文字位置INDEX Dim POS2 As Long ' レコード文字位置INDEX ' Applicationオブジェクト取得 Set xlAPP = Application ' 「ファイルを開く」のダイアログでファイル名の指定を受ける xlAPP.StatusBar = "読み込むファイル名を指定して下さい。" vntFileName = xlAPP.GetOpenFilename(FileFilter:=cnsFilter, _ Title:=cnsTitle) ' キャンセルされた場合はFalseが返るので以降の処理は行なわない If VarType(vntFileName) = vbBoolean Then Exit Sub strFileName = vntFileName ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' 指定ファイルをOPEN(入力モード) Open strFileName For Input As #intFF GYO = 13 ' ファイルのEOF(End of File)まで繰り返す Do Until EOF(intFF) ' レコード件数カウンタの加算 lngREC = lngREC + 1 xlAPP.StatusBar = "読み込み中です....(" & lngREC & "レコード目)" ' 行単位にレコードを読み込む Line Input #intFF, strREC ' (1) ' LineInputより自分で半角カンマを探しCSV→項目分割させる POS1 = 1 IX1 = 0 ReDim X(IX1) ' 配列を初期化 Do While POS1 <= Len(strREC) ' (2) POS2 = InStr(POS1, strREC, ",", vbTextCompare) ' (3) If POS2 < POS1 Then POS2 = Len(strREC) + 1 End If ReDim Preserve X(IX1) ' 配列要素数を再設定 X(IX1) = Trim$(Mid$(strREC, POS1, POS2 - POS1)) ' (4) ' シングルクォーテーション、ダブルクォーテーションで囲まれている場合は ' 両端文字を取り除く If (((Left$(X(IX1), 1) = """") And (Right$(X(IX1), 1) = """")) Or _ ((Left$(X(IX1), 1) = "'") And (Right$(X(IX1), 1) = "'"))) Then ' (5) X(IX1) = Trim$(Mid$(X(IX1), 2, Len(X(IX1)) - 2)) End If POS1 = POS2 + 1 IX1 = IX1 + 1 Loop ' 行を加算しレコード内容を表示(先頭は2行目) GYO = GYO + 1 If IX1 >= 1 Then Range(Cells(GYO, 1), Cells(GYO, IX1)).Value = X ' 配列渡し (6) End If Loop ' 指定ファイルをCLOSE Close #intFF xlAPP.StatusBar = False ' 終了の表示 MsgBox "ファイル読み込みが完了しました。" & vbCr & _ "レコード件数=" & lngREC & "件", vbInformation, cnsTitle End Sub

  • Excel2010 VBAでテキストファイル読込

     初めて質問させていただきます。  Excel2010のVBAで下記のようなマクロを組み、テキストファイルを読込したところ、データの一部が誤変換されてしまいます。  誤変換内容  11/12/29 →2029/11/12  マクロを使用せず、Excelから直接テキストファイルウィサードを使って読み込んだ場合には、正しく「2011/12/29」となります。  (お恥ずかしい話ですが、Excelシートのセルに直接「11/12/29」と打ち込むと自動的に「2011/12/29」に変換されることを今回初めて知りました。)  同一項目には「11/12/29」形式と「20111229」形式が混在しており、「11/12/29は2011/12/29」、「20111229はそのまま」セルに格納するよう依頼されています。  従って、Array(1, 2)で文字列やArray(1, 5)でYMD形式の日付へ同一項目のデータを固定することはできなくなっております。  テキストデータは「カンマ区切り」の35項目です。  データはネットワーク内の他のPCドライブに保存されています。  因みに「 Workbooks.OpenText Filename:=」以下は、Excelのマクロ記録で取得したものです。  お忙しいところ恐縮ですが、よろしくお願いいたします。 【作成したマクロ】 Sub 読込() With CreateObject("WScript.Shell") .currentdirectory = "\\コンピューター名\c\フォルダ名\" End With Const cnsTITLE = "テキストファイル読み込み処理" Const cnsFILTER = "全てのファイル (*.*),*.*" Set xlAPP = Application xlAPP.StatusBar = "読み込むファイル名を指定して下さい。" strFILENAME = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, _ Title:=cnsTITLE) If StrConv(strFILENAME, vbUpperCase) = "FALSE" Then Exit Sub Workbooks.OpenText Filename:=strFILENAME, Origin:=932, _ StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _ , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _ Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _ Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _ 16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _ Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array( _ 29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1)) _ , TrailingMinusNumbers:=True End Sub

  • Excel VBA: Inputステートメントで読み込むと、データ中のカンマで切れてしまう。

    いつも皆様ありがとうございます。 ExcelのVBAで、以下の仕様のテキスト・ファイルを1行ずつ読み込もうとしています。 【仕様】 ・1行は1つ以上のスペースで区切られた複数の値から成る。 ・値中に、半角カンマが含まれる場合がある。 値中にカンマが存在しない場合は、問題なく改行まで読み込まれるのですが、カンマがあるとそのカンマ以降のデータが読み込まれません。 Dim intFF As Integer 'FreeFile値 Dim strFileName As String 'ファイル名 Dim strRec As String '1行の読み込み内容 strFileName = "TEST.txt" intFF = FreeFile Open strFileName for Input As #intFF Do Until EOF(intFF) Input #intFF, strREC ' ※1 ・・・(省略) 上記※1のコード実行後にstrRECの中を見ると、カンマ以降の文字列が読み込まれていません。 例えば「A BB CCC DDDD」というデータの場合は問題なくそのままの値がstrRECの中に入っていますが、「A BB CC,C DDDD」というデータだと「A BB CC」というようになってしまいます。 Inputステートメントについて調べましたが、区切り文字に関する記述がなかったので困っています。 もし原因をご存知の方がいらっしゃいましたらお教えいただけないでしょうか。 よろしくお願いいたします。

  • エクセルVBAでテキスト保存

    エクセルのファイルをメモ帳で保存する場合に下記のコードが書いてあります。 strFILENAME = xlAPP.GetSaveAsFilename(InitialFileName:="データxxx_yyy_zzz.txt",FileFilter:=cnsFILTER, Title:=cnsTITLE) このうち、ファイル名の"データxxx_yyy_zzz.txt"、xxx, yyy,zzzをそれぞれ、特定のセルから取得したい場合、どのように直せばいいのでしょうか? xxx=A1セル yyy=A2セル zzz=A3セル といった感じです。 よろしくお願いします。

  • エクセル2007VBAの質問です。

    エクセル2007VBAで下記の事をしたいのですがうまくいきません。 ・エクセルシートの数式を消して値を残したものを別名で保存する。 ※保存時は「名前をつけて保存」ダイアログを出したいです。 現在は、下記内容で記述してみましたが、保存されません。 初心者がネットで調べて書いたので、めちゃくちゃな所があると思いますが宜しくお願いします。 ------------------------------------------------------------- Sub シートコピー() ' ' シートを別のブックにコピーする。 ' ' Const cnsTITLE = "エクセル作成" Const cnsFILTER = "エクセルファイル (*.xls),*.xls" Const xlsfile = "C:\temp\ファイル名を入力して下さい。" ' Columns("A:R").Select Selection.Copy Workbooks.Add Columns("A:A").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Set xlsApp = Application xlsApp.StatusBar = "出力ファイル名を指定して下さい。" strFILENAME = xlsApp.GetSaveAsFilename(InitialFileName:=xlsfile, _ FileFilter:=cnsFILTER, title:=cnsTITLE) End Sub -------------------------------------------------------------