お世話になります。
以下の条件で動作するマクロを必要としています。
詳しい方、ご教授のほどよろしくお願いします。
細かな条件もあり恐縮です。一部無理でも結構です。
1.複数のcsvファイルのデータを1つのエクセルファイルにコピー統合したい。
2.ファイル名は「帳票00」~「帳票10」となっており、番号順に開いてコピーする。
3.ファイルは一部「帳票5(1)」「帳票5(2)」と分かれている。
4.ファイルは一部「帳票7」の次が「帳票9」(8は欠番)などととなっている。
5.コピーは行列を入れ替えてコピーする。
6.2つ目以降のファイルをコピーする位置は、前ファイルの次の行からとする。
 (帳票00が10行まで入っていたら、帳票01は11行A列から入るようにする。)
7.2つ目の「帳票01」以降はA列B列はコピー不要とする。
 (A列B列は見出しとなっていて、はじめに1回コピーされればよい。)

このQ&Aに関連する最新のQ&A

A 回答 (3件)

>ファイル名の番号の若い順から開くにはどうすればよいでしょうか。



3&4の回答で書いたDirのあとソートすればできます。
以下はサンプルです。

-----------------------------------------------
Sub ファイルリスト作成()

'初期設定
Dim Line As Long
Dim Filename As String
Dim Filenames As String
Sheet1.Cells.ClearContents
'リスト作成
Line = 1
Filename = Dir(ThisWorkbook.Path & "\*.*")
Do While Filename <> ""
Filenames = StrConv(Filename, vbLowerCase)
If Not (Filenames Like "*.xls" Or Filenames Like "*.bat" ) _
Then
Line = Line + 1
Cells(Line, 1) = Filename
End If
Filename = Dir()
Loop

If Line = 1 Then
MsgBox "対象となるファイルがありません"
Exit Sub
End If

'ソート
[A1].Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin

End Sub
    • good
    • 0
この回答へのお礼

詳しいご回答ありがとうございました。
参考になりました!

お礼日時:2009/05/20 00:33

サンプルの前提条件を書き忘れました。



このサンプルのあるエクセルブックが、対象となるcsvファイルと同じフォルダにあることを想定しています。
    • good
    • 0

こんばんは



とりあえずすぐに回答できるところから。

1&2
csvを順次「Worksheets.Open」で開きコピー&ペーストします。

3&4
「元データのcsvファイルがすべて同じフォルダにある」&「そのフォルダには余計なcsvファイルは置かれていない」という条件なら、Dir関数を使って対象ファイルのリストを作ることができます。


PasteSpecial メソッドの「Transpose」のオプションで設定できます。
マクロの記録で、形式を指定して貼り付け(行列を入れ替えるにチェック)で試してみてください。

6&7
Ifで分岐できます。

質問にはありませんが元データのcsvファイルの最終行を取得するには
Cells(Rows.Count, "A").End(xlUp).Row
が使えます。(バージョン2000~2007に対応、エクセルの最終行までデータが入っていないことが条件)

以上、参考になれば。
追加で回答できる部分があれば、改めて回答します。
また、詳細が分からない場合には、「補足」に書き込みしてください。

この回答への補足

早速のご回答ありがとうございます。
補足ですが、ファイルは実際は100個ほど同じフォルダ内にあります。
他に余計なファイルはありません。
ファイル名の番号の若い順から開くにはどうすればよいでしょうか。

補足日時:2009/05/16 23:56
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q大量のCSVデータを1つのエクセルデータにまとめる方法について

今仕事で、CSVファイルが400ファイル程あり、これを一つの
エクセルファイルにまとめなくて加工しなければならないのですが
うまいことVBAを活用して効率的にできないか思案中なのですが
うまい具合に行きません。
データの持ち方として
○CSVファイル1
1.AAA
2.BBB

○CSVファイル2
3.CCC
4.DDD

となっており、これを1つのエクセルファイル上で
1.AAA
2.BBB
3.CCC
4.DDD
としたいのですがなにかいい方法はないでしょうか?
1つのブックで外部データの取り込みでCSVを次々に選択して
いくVBAなんてあれば教えていただけないでしょうか?
よろしくお願いします。

Aベストアンサー

こんにちは。
昔書いた事があるサンプルです。
同一フォルダにあるcsvファイルをまとめて処理します。

Sub CSVまとめsample()
  Dim MyObj As Object
  Dim MyFol As String
  Dim MyFnm As String
  Dim MyStr As String
  Dim i   As Long
  Dim n   As Long
  Dim n1  As Long
  
  'フォルダを選択する
  Set MyObj = CreateObject("Shell.Application") _
    .BrowseForFolder(0, "SelectFolder", 0)
  '選択なければ処理を抜ける
  If MyObj Is Nothing Then Exit Sub
  MyFol = MyObj.self.Path & "\"
  MsgBox MyFol & "を処理します。"
  Set MyObj = Nothing
  Application.ScreenUpdating = False
  'ThisWorkbookにシートを追加して処理
  With Sheets.Add
    'Dir関数を使って指定フォルダ内csvファイルを順次処理
    MyFnm = Dir(MyFol & "*.csv")
    Do Until Len(MyFnm) = 0&
      i = i + 1
      'データエリアを取得してセット先を変更
      n = IIf(n = 0, 1, n + n1)
      '外部データ取り込みを利用
      With .QueryTables.Add(Connection:="TEXT;" & MyFol & MyFnm, _
                 Destination:=.Range("B" & n))
        .AdjustColumnWidth = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileCommaDelimiter = True
        .Refresh False
        n1 = .ResultRange.Rows.Count
        .Parent.Names(.Name).Delete
        .Delete
      End With
      'ファイル名をA列にセット
      .Range("A" & n).Resize(n1).Value = MyFnm
      '次のファイルへ
      MyFnm = Dir()
    Loop
  End With
  If i > 0 Then
    MyStr = i & "個のファイルを処理しました。"
  Else
    '検索結果が0なら
    MyStr = "検索条件を満たすファイルはありません。"
  End If
  Application.ScreenUpdating = True
  MsgBox MyStr
End Sub

#シート行数をオーバーした時のエラー処理などはしてないので
#うまくいかなかったらごめんね^ ^;

こんにちは。
昔書いた事があるサンプルです。
同一フォルダにあるcsvファイルをまとめて処理します。

Sub CSVまとめsample()
  Dim MyObj As Object
  Dim MyFol As String
  Dim MyFnm As String
  Dim MyStr As String
  Dim i   As Long
  Dim n   As Long
  Dim n1  As Long
  
  'フォルダを選択する
  Set MyObj = CreateObject("Shell.Application") _
    .BrowseForFolder(0, "SelectFolder", 0)
  '選択なければ処理を抜ける
  If MyObj Is Nothi...続きを読む

Qエクセルマクロ、複数のCSVファイルを読み込んで一つのファイルに繋げる方法

別質問で教えて貰った方法(下記URLの#2)で、複数のCSVファイルを
読み込むマクロはわかったのですが、それらのファイルを一つに
まとめる方法がよくわかりません。

新しいシート(or結果保存用のブック)を用意して、ここに順に繋げて
いきたいのですが、どうしたら良いのでしょうか。

ちなみに、入力されるCSVファイルのデータの入っている列数は固定
なのですが、行数はファイル毎に異なります。

<大元の質問>
http://oshiete1.goo.ne.jp/kotaeru.php3?q=359726

Aベストアンサー

こんにちは。

#2さんの回答で解決かもしれませんが、元の質問からの流れで、、、

単純な、開く、コピー、貼付け、閉じるの繰り返し処理です。

Sub Test()
Dim Files, FilesCnt As Integer, i As Integer
Dim cBook As Workbook, pBook As Workbook
 
 Files = Application.GetOpenFilename _
    (FileFilter:="CsVFile(*.csv), *.csv", MultiSelect:=True)
 If IsArray(Files) Then
   Set pBook = Workbooks.Add(xlWBATWorksheet)
   FilesCnt = UBound(Files)
   For i = 1 To FilesCnt
     Workbooks.Open Files(i)
     Set cBook = ActiveWorkbook
     cBook.ActiveSheet.UsedRange.Copy
     With pBook.ActiveSheet
      .Cells(.Range("A65536").End(xlUp).Row, 1). _
      PasteSpecial (xlPasteAll)
     End With
     Application.CutCopyMode = False
     cBook.Close
   Next i
 End If
Set cBook = Nothing: Set pBook = Nothing
End Sub

こんにちは。

#2さんの回答で解決かもしれませんが、元の質問からの流れで、、、

単純な、開く、コピー、貼付け、閉じるの繰り返し処理です。

Sub Test()
Dim Files, FilesCnt As Integer, i As Integer
Dim cBook As Workbook, pBook As Workbook
 
 Files = Application.GetOpenFilename _
    (FileFilter:="CsVFile(*.csv), *.csv", MultiSelect:=True)
 If IsArray(Files) Then
   Set pBook = Workbooks.Add(xlWBATWorksheet)
   FilesCnt = UBound(Files)
   For i = 1 To ...続きを読む

Q複数のcsvファイルを1つのEXCELファイルにマージするVBAを教えてください

csvファイル数は700~1000個程度でひとつのフォルダに格納されています。
このファイルをEXCEL形式で開くと、1行目にフィールド名(A~Z列で固定)、2行目以降にデータが入っています。行数はファイルにより1~100行程度で変動します。

このファイルを1つのエクセルファイルの同一シートに結合(マージ)するVBAがほしいです。
ここで、(できればですが)EXCELにマージするにあたり、1行目のみフィールドの値、2行目以降にそれぞれのcsvの2行目以降データの値を入れていくようにしたいです。つまり、フィールド名の行が何行も出てくるのを避けたいです。

申し訳ございませんが、ご指導いただけたら幸いです。よろしくお願いします。

Aベストアンサー

しばらく前に書いた事があるコードです。
参考になるようだったら応用してみてください。

'---------------------------------------------------------------------
Private Sub try()
  Dim ws As Worksheet
  Dim fd As String
  Dim fn As String
  Dim ret As String
  Dim i  As Long
  Dim n  As Long
  Dim x  As Long
  Dim s  As Long
  
  fd = ThisWorkbook.Path & "\"
  'fd = FDSELECT 'フォルダ選択の場合

  If Len(fd) = 0& Then Exit Sub
  Application.ScreenUpdating = False
  'ActiveWorkbookにシートを追加して処理
  Set ws = Sheets.Add
  On Error GoTo errHndler
  fn = Dir(fd & "*.csv")

  x = 1
  s = 1
  Do Until Len(fn) = 0&
    i = i + 1
    'データCountにより次のセット先変更
    n = n + x
    '外部データ取り込み
    x = CSVQRY(ws, fd & fn, ws.Cells(n, 2), s)
    If x < 0 Then
      Err.Raise Number:=1000, Description:="CSV読み込みに失敗"
    ElseIf (n + x) >= Rows.Count Then
      '行数overしてもエラーかからないため取り込み直し
      ws.Rows(n).Resize(x).Delete
      Set ws = Sheets.Add
      n = 1
      x = CSVQRY(ws, fd & fn, ws.Cells(n, 2), 1&)
    End If
    'ファイル名をA列にセット
    ws.Cells(n, 1).Resize(x).Value = fn
    s = 2
    fn = Dir()
  Loop

  If i > 0 Then
    ret = i & "files.done"
  Else
    ret = "no file"
  End If

errHndler:
  If Err.Number <> 0 Then
    ret = Err.Number & vbTab & Err.Description
    Debug.Print ret
  End If
  Application.ScreenUpdating = True
  MsgBox ret
  Set ws = Nothing
End Sub
'---------------------------------------------------------------------
Private Function CSVQRY(ByRef ws As Worksheet, _
            ByRef fs As String, _
            ByRef rs As Range, _
            ByVal sr As Long) As Long
  Dim cnt As Long

  On Error GoTo errChk
  With ws.QueryTables.Add(Connection:="TEXT;" & fs, _
              Destination:=rs)
    .AdjustColumnWidth = False
    .TextFilePlatform = xlWindows
    .TextFileStartRow = sr
    .TextFileCommaDelimiter = True
    .Refresh False
    cnt = .ResultRange.Rows.Count
    .Parent.Names(.Name).Delete
    .Delete
  End With
  CSVQRY = cnt
  Exit Function
errChk:
  CSVQRY = -1
End Function
'---------------------------------------------------------------------
Private Function FDSELECT() As String 'フォルダ選択Function
  Dim obj As Object
  Dim ret As String

  Set obj = CreateObject("Shell.Application") _
       .BrowseForFolder(0, "SelectFolder", 0)
  If obj Is Nothing Then Exit Function
  On Error Resume Next
  ret = obj.self.Path & "\"
  If Err.Number <> 0 Then
    ret = obj.Items.Item.Path & "\"
    Err.Clear
  End If
  On Error GoTo 0
  Set obj = Nothing
  FDSELECT = ret
End Function

しばらく前に書いた事があるコードです。
参考になるようだったら応用してみてください。

'---------------------------------------------------------------------
Private Sub try()
  Dim ws As Worksheet
  Dim fd As String
  Dim fn As String
  Dim ret As String
  Dim i  As Long
  Dim n  As Long
  Dim x  As Long
  Dim s  As Long
  
  fd = ThisWorkbook.Path & "\"
  'fd = FDSELECT 'フォルダ選択の場合

  If Len(fd) = 0& Then Exit Sub
 ...続きを読む

Q複数のCSVファイルからのデータ取得(VBA)

エクセルVBAで、エクセルの指定シートに複数のCSVファイルからデータを取得する方法を
ご教授お願います。
エクセルの指定シートの指定されたセルに、複数のCSVファイルから指定箇所のデータを
取得し転送する方法を考えていますが、どうもうまくいきません。
たとえば、
CSVファイル(1) A5(A)
          A10(B)
CSVファイル(2) A5(C)
          A10(D)     
CSVファイル(3) A5(E)
          A10(F)   
     ・
     ・
     ・
と、指定されたセルからデータを取得し、
エクセルの指定シートの表に
                   CSVファイル               
                 (1)  (2)  (3) ・ ・ ・
-------------------------------------------
A5から取得したデータ    A   C   E ・ ・ ・
A10から取得したデータ    B   D   F ・ ・ ・
-------------------------------------------
と、いうように転送して貼り付けていきたいです。

いろいろ調べてみたのですが、このような方法が見つけられませんでした。
ぜひ、皆様のお知恵をお貸しください。
宜しくお願い致します。

エクセルVBAで、エクセルの指定シートに複数のCSVファイルからデータを取得する方法を
ご教授お願います。
エクセルの指定シートの指定されたセルに、複数のCSVファイルから指定箇所のデータを
取得し転送する方法を考えていますが、どうもうまくいきません。
たとえば、
CSVファイル(1) A5(A)
          A10(B)
CSVファイル(2) A5(C)
          A10(D)     
CSVファイル(3) A5(E)
          A10(F)   
     ・
     ・
     ・
と、指定さ...続きを読む

Aベストアンサー

>読み込むCSVファイルは毎回ファイル名が変わる為、マクロでファイルを選択し、選択したファイルからそれぞれデータを取得したいのですが、変数への置き換え方が分かりません。

私は、基本的にはまったく知らない方には、ブラックボックスとして使っていただくように考えています。

ファイル名が決まっているような質問の内容でしたから、そういうコードにしたまででしたが、すでに、#2のコードを書く時に、以下のように考えていました。

試してみてください。書き換えは、必要に応じて「パスを登録」の部分だけです。
また、なくても、可能です。
ファイルの選択は、Ctrl キーを押しながらファイルを一つずつ選ぶか、シフトキーを押しながら範囲を選ぶかしてください。選択した順序どおりに処理されます。

'//
Sub TestMacro1R()
 Dim sh As Worksheet
 Dim Files As Variant
 Dim i As Long, j As Long, k As Long
 Dim oPath As String
 Dim sPath As String
 oPath = ThisWorkbook.Path
 sPath = ThisWorkbook.Path & "\MyFolder\" 'パスを登録
 Set sh = ThisWorkbook.ActiveSheet '書きだすシート
 ChDir sPath
 Files = Application.GetOpenFilename("Text(*.csv),*.csv", , "ファイル選択", , True)
 If VarType(Files) = vbBoolean Then Exit Sub
 k = 1 '書き出し列
 j = 1 '書き出し行
 For i = UBound(Files) To 1 Step -1
  If k > Columns.Count Then MsgBox "列の制限より終了します。", 48: Exit For
   Application.ScreenUpdating = False
   With Workbooks.Open(Files(i))
    sh.Cells(j, k).Value = .ActiveSheet.Range("A5").Value
    sh.Cells(j + 1, k).Value = .ActiveSheet.Range("A10").Value
    .Close False
   End With
   k = k + 1
  Application.ScreenUpdating = True
 Next
 Set sh = Nothing
 ChDir oPath
 Beep
End Sub

>読み込むCSVファイルは毎回ファイル名が変わる為、マクロでファイルを選択し、選択したファイルからそれぞれデータを取得したいのですが、変数への置き換え方が分かりません。

私は、基本的にはまったく知らない方には、ブラックボックスとして使っていただくように考えています。

ファイル名が決まっているような質問の内容でしたから、そういうコードにしたまででしたが、すでに、#2のコードを書く時に、以下のように考えていました。

試してみてください。書き換えは、必要に応じて「パスを登録」の部分だ...続きを読む

Q複数の同じフォーマットのファイルを新しいブックで一つのシートにまとめる方法

仕事で、各部署から送られてきた、同じフォーマットのファイル(シート1にのみデータ有)が50個近くあります。
それを新しいブックで一つのシートにまとめなくてはいけません。
地道にコピペするのは時間がかかるのでマクロで処理を行いたいと思います。
マクロでの処理方法ご存知の方、処理方法の載っているサイトをご存知の方、もしくはマクロより簡単な方法がありましたら教えてください。

あと、逆に一つのシートをいくつかのファイルに振り分けていく方法もご存知でしたら教えて下さい。
よろしくお願いします。

Aベストアンサー

すみません。質問を勘違いしていました。
>新しいブックで一つのシートにまとめなくてはいけません
でしたね。
Sub Sample1()
Dim buf As String, i As Long
Dim j
buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
Do While buf <> ""
Workbooks.Open Worksheets("Sheet1").Range("A1").Value & "\" & buf
Sheets("Sheet1").Range("A1:J1000").Copy
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Workbooks(buf).Activate
Application.CutCopyMode = False
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop
End Sub
で試してみてください。使い方などは
http://oshiete1.goo.ne.jp/qa4225063.html
を参照してみてください。同じ質問があったので気がつきました。

すみません。質問を勘違いしていました。
>新しいブックで一つのシートにまとめなくてはいけません
でしたね。
Sub Sample1()
Dim buf As String, i As Long
Dim j
buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
Do While buf <> ""
Workbooks.Open Worksheets("Sheet1").Range("A1").Value & "\" & buf
Sheets("Sheet1").Range("A1:J1000").Copy
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Workbooks(buf).Activate
Application.CutCop...続きを読む

Q大量のCSVデータを行列の変換をしてエクセルデータにまとめる方法について

CSVファイルが4000個ほどあり、VBAを用い、そのファイルの行列変換をして、1つのエクセルファイルにまとめたいのですが、うまくいきません。どなたか教えていただけないでしょうか?

CSVファイルは、以下の様な2列200行位あるものを、2列目のみ取り出し、エクセルファイルには1行(列ではなく)にして取り出したいのです。

変換前データー

A列   B列

B013 毛
B014 54
B015 ポリエステル
B016 36
B017 絹
B018 10
B020 0
B022 0
B023 ポリエステル
B024 0
B025 キュプラ
B026 0
B028 0
B030 0
B032 0
 ・  ・
 ・  ・
 ・  ・


取り込み変換後データ

1行: 毛 54 ポリエステル 36 絹 10 0 0 ポリエステル 0 キュプラ 0 0 0 0


のようにしたいのです。
どなたかお教えいただけないでしょうか?
よろしくお願いいたします。

CSVファイルが4000個ほどあり、VBAを用い、そのファイルの行列変換をして、1つのエクセルファイルにまとめたいのですが、うまくいきません。どなたか教えていただけないでしょうか?

CSVファイルは、以下の様な2列200行位あるものを、2列目のみ取り出し、エクセルファイルには1行(列ではなく)にして取り出したいのです。

変換前データー

A列   B列

B013 毛
B014 54
B015 ポリエステル
B016 36
B017 絹
B018 ...続きを読む

Aベストアンサー

4000個もあるんじゃマクロじゃなきゃできませんよね。
次の手順を試してみてください。
その4000個程度のCSVファイルが入っているフォルダーに、以下のマクロを書いたエクセルBOOKを保存してください。(パス取得のため必ず「保存」してください。)
そのフォルダー内の全てのCSVファイルから、B1:B256の範囲のデータを読み込み、エクセルの.Sheets("Sheet1")の1行目から順に転記していきます。
読み込むのをB1:B256としたのは、わたしのエクセルが2007ではないので、行列を入れ替えたとき列が256列までしかないからです。でも200件程度のデータなら大丈夫ですね?

Sub test01()
Dim myFile As String, MyPath As String '変数宣言
Dim i As Long
Dim wb As Workbook
MyPath = ThisWorkbook.Path & "\" '自分のパスを取得
myFile = Dir(MyPath & "*.csv", vbNormal) 'パス内のcsvファイル
Application.ScreenUpdating = False '画面更新停止
Application.Calculation = xlCalculationManual '自動計算停止
Do Until myFile = "" '対象ファイルがなくなるまで
Set wb = Workbooks.Open(MyPath & "\" & myFile) '選択したファイルを開く
ThisWorkbook.Sheets("Sheet1").Range("A1:IV1").Offset(i).Value = _
Application.Transpose(wb.Sheets(1).Range("B1:B256").Value) '行列を入れ替えて転記
i = i + 1 'カウント
wb.Close (False) '開いたファイルを閉じる
myFile = Dir '次のファイルを検索
Loop '繰り返し
Application.Calculation = xlCalculationAutomatic '自動計算停止解除
Application.ScreenUpdating = True '画面更新停止解除
Set wb = Nothing
MsgBox i & "件のCSVファイルから転記しました。", vbInformation, " " & Environ("UserName") & "さん (o^-')v "
End Sub

4000個もあるんじゃマクロじゃなきゃできませんよね。
次の手順を試してみてください。
その4000個程度のCSVファイルが入っているフォルダーに、以下のマクロを書いたエクセルBOOKを保存してください。(パス取得のため必ず「保存」してください。)
そのフォルダー内の全てのCSVファイルから、B1:B256の範囲のデータを読み込み、エクセルの.Sheets("Sheet1")の1行目から順に転記していきます。
読み込むのをB1:B256としたのは、わたしのエクセルが2007ではないので、行列を入れ替えたとき列が256列までし...続きを読む

QExcelの複数ファイルの内容を一つのファイルに集計する方法について教

Excelの複数ファイルの内容を一つのファイルに集計する方法について教えてください。
各支店からの報告を集計したいのですが、同一フォームのファイル(約100ファイル)で報告されるデータを一つのファイルに集計したいと思っています。
A支店ファイルのsheet1、B支店ファイルのsheet1、・・・・を、合計ファイルのsheet1に集約したいのです。(フォームは同じで、内容は数値のみです。)
いい方法がある方、お教えください。

Aベストアンサー

フォルダー内の全エクセルファイルのデータを1シートにまとめるVBAのコードはWeb検索すれば、種々みつかります。下記はコードの若干の解説もあって良いと思います。
http://hpcgi1.nifty.com/kenzo30/b_cbbs/cbbs.cgi?mode=al2&namber=39812&no=0&P=R&KLOG=266
問題は、「同一フォーム」の内容ですね。
データ中に各支店名が含まれていなければ、抽出時に付与しないと訳が分からなくなるし、
変に凝った様式だと単純にコピーするだけではうまくいかないし。

QVBAでフォルダ内の全てのcsvファイルからコピペ

マクロ超初心者です。

フォルダ内のすべてのcvsファイル(500程度)の5列目(500行程度)を新規ファイルの1列目から順にコピーしていきたいのです。

ちなみに元のcvsファイルのシート数は一つだけでシート名には全てファイル名が付いています。
(つまり全てのファイルのシート名が異なる)

見よう見真似で似たようなマクロから意味もわからないまま
つぎはぎして下記作りましたが
やっぱり動きません。

どなたか詳しい方どうかよろしくお願いします。


Sub Sample()
Const FolderPath As String = "C:\data"
Dim objFSO As Object
Dim objBook As Object
Dim lngRow As Long

Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objBook In objFSO.GetFolder(FolderPath).Files
lngcolumn = ThisWorkbook.Sheets("sheet1").Range("A" & Columns.Count).End(xlToRight).Column + 1
Workbooks.Open objBook.Path
With ActiveWorkbook
.Worksheets(1).Column("5").Copy ThisWorkbook.Sheets("sheet1").End(xlToRight).Offset(0, 1)
.Close
End With
Next

Set objFSO = Nothing

Application.ScreenUpdating = True

End Sub

マクロ超初心者です。

フォルダ内のすべてのcvsファイル(500程度)の5列目(500行程度)を新規ファイルの1列目から順にコピーしていきたいのです。

ちなみに元のcvsファイルのシート数は一つだけでシート名には全てファイル名が付いています。
(つまり全てのファイルのシート名が異なる)

見よう見真似で似たようなマクロから意味もわからないまま
つぎはぎして下記作りましたが
やっぱり動きません。

どなたか詳しい方どうかよろしくお願いします。


Sub Sample()
Const FolderPath As String = ...続きを読む

Aベストアンサー

私なら、こんな感じで作ります。

Sub test()
Const FolderPath As String = "C:\data"
Dim Filename As String
Dim Sh0 As Worksheet, Sh As Worksheet
Dim c As Long

Set Sh0 = ActiveSheet
Filename = Dir(FolderPath & "\*.csv")
Do Until Filename = ""
c = c + 1
Set Sh = Workbooks.Open(FolderPath & "\" & Filename).Sheets(1)
Sh.Columns(5).Copy Sh0.Columns(c)
Application.DisplayAlerts = False
Sh.Parent.Close
Application.DisplayAlerts = True
Filename = Dir()
Loop
End Sub

私なら、こんな感じで作ります。

Sub test()
Const FolderPath As String = "C:\data"
Dim Filename As String
Dim Sh0 As Worksheet, Sh As Worksheet
Dim c As Long

Set Sh0 = ActiveSheet
Filename = Dir(FolderPath & "\*.csv")
Do Until Filename = ""
c = c + 1
Set Sh = Workbooks.Open(FolderPath & "\" & Filename).Sheets(1)
Sh.Columns(5).Copy Sh0.Columns(c)
Application.DisplayAlerts = False
Sh.Parent.Close
...続きを読む

QエクセルVBAでCSVを読み込んで別ファイルにまとめたいです。

エクセルVBA初心者の者です。

マクロの記録でできたコードをいじって、
なんとか動くものができるレベルです。

Aというフォルダに20~40行程度の内容のCSVファイルが
数百個あります。開けてみないと何行あるのかわかりません。

そのAフォルダのCSVの内容をエクセルで開いて、別のエクセルファイルの一枚のシートにまとめたいのです。

最初にCSVファイル名を一枚のシートのA列に書き出すところ
まではやれたのですが、それを順番に読み込んでコピペの
流れができません。

CSVファイル名読み込み
読み込んだファイル1つめCSV開く
CSVの20~40行をコピー
別のエクセルファイルのシートに貼り付け
1つめCSV閉じる

読み込んだファイル2つめCSV開く
繰り返し

こういうやり方じゃない方がいいのかもわかりません。

もしかして考え方も違うのでしょうか?

サンプルコード教えていただけるとありがたいです。
よろしくお願いします。

Aベストアンサー

ファイルの読み込み時にデータ形式によって何かの処理が必要な場合であれば別ですが、先にファイルを一つにまとめてしまい一気に読みこむ方法もあります。

http://www.relief.jp/itnote/archives/001770.php
http://www.relief.jp/itnote/archives/002775.php

コマンドプロンプト上でCOPYコマンドやTYPEコマンドですべてのファイルを結合する事が出来ます。

http://can-chan.com/vba/filemei-itiransakusei.html
エクセルのマクロでシート上にフォルダー内のCSVファイルの一覧を取得
セルの中身を
copy 纏めるファイル名.CSV + 取得したファイル名.CSV
に変更しTEXTファイルとして保存、名前の変更でBATファイルに変更して目的のフォルダー上で実行すれば1つのファイルとなりますので、そのままExcelで開く。

マクロの勉強にはならないかもしれないけど、違う方面で参考になるかと。

Qフォルダ内の全てのBookに同じ処理を繰り返す

フォルダ内にエクセルファイルが約3,000個あります。
この全てのBookに同じ処理をしたいのですが、マクロで繰り返す方法がわからないので教えて下さい。
処理をする内容は簡単なもので、マクロで作りました。

・ 各Bookには1つのシートしか存在せず、シート名は重要ではないので全て「Sheet1」になっています。
・ 各Bookのデータの配置や表形式は同じです。
・ レコードの行数がBookによって異なります。

処理の内容をマクロで作るところまではできましたが、知識がないためタイムアウトです。

ご教示宜しくお願い致します。

Aベストアンサー

だいたいこんな流れで。

sub macro1()
 dim myPath as string
 dim myFile as string

 mypath = "C:\test\"

’指定フォルダのブックを順繰り拾う
 myfile = dir(mypath & "*.xls*")
 do until myfile = ""

 ’ブックを開いて処理を行い保存して閉じる
  workbooks.open mypath & myfile
  activesheet.range("A1") = "DONE"
  activeworkbook.close true

  myfile = dir()
 loop
end sub


必要に応じて
・画面の表示を抑制する
・再計算を手動にする
といった手管を追加して高速化を図ります。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報