| |
いつもありがたく勉強させてもらっています。m(_ _)m
特定のフォルダ"file_A"に入っている全てのエクセルファイルの、特定のシートにあるデータをVBで抜き出そうと思っています。
file_Aフォルダには、A.xls,B.xls,C.xls,...と複数のエクセルファイルが入っていますが、全て同フォーマットで作られています。
それぞれに「シート」という名前のsheetがあり、A1セル〜G14にわたってテキストデータが存在します。
そのテキストデータを自動的にVB実行元のファイル内のsheet"抽出"のA1行から順に並べたいと思っています。
イメージとしてはこうです。
A.xlsの"シート"sheet：
A A A A A A A
A A A A A A A
A A A A A A A
B.xlsの"シート"sheet：
B B B B B B B
B B B B B B B
B B B B B B B
C.xlsの"シート"sheet：
C C C C C C C
C C C C C C C
C C C C C C C
VB実行後の"抽出"sheet(VB実行元ファイル)：
A A A A A A A
A A A A A A A
A A A A A A A
B B B B B B B
B B B B B B B
B B B B B B B
C C C C C C C
C C C C C C C
C C C C C C C
このように抽出して並べたいと思っています。
そこで、
Sub vbsample()
Application.ScreenUpdating = False
Dim MyPath As String
Dim MyName As String
Dim OpenFileName As String
Dim zentai As Variant
Dim gyo As Integer
Dim retsu As Integer
Dim wb As Workbook '参照元ファイル用
Dim skb As Workbook 'データ抽出ファイル用
gyo = 1 'データを貼り付ける先頭行
Set skb = ActiveWorkbook
MyPath = "C:\Documents and Settings\Administrator\デスクトップ\file_A" 'xlsが入っているフォルダ名を指定
MyName = Dir(MyPath & "\*.xls") '.xlsがつく全てのファイルを対象とする
Do While MyName <> "" '全てのファイルを参照するまでLoop処理
OpenFileName = MyPath & "\" & MyName '現在の参照元のエクセルファイルへのパス
Workbooks.Open (OpenFileName)
Set wb = ActiveWorkbook
zentai = Worksheets("シート").Range("A1:G14").FormulaR1C1 '抽出したいデータを含むセルの範囲を指定
retsu = 1 'データを貼り付ける先頭列
For Each zentai In Worksheets("シート").Range("A1:G14")
skb.Worksheets("抽出").Cells(gyo, retsu) = zentai
retsu = retsu + 1
Next
gyo = gyo + 1 'ファイルが変わると行を下げる
MyName = Dir '参照元ファイルをnullに
wb.Close (False) '保存なしで閉じる
Loop '処理を繰り返す
Sheets("抽出").Select
End Sub
との式を使用しているのですが、結果が下記のようになってしまいます。
(一つのファイルから嫡出したデータが横並びになってしまう)
A A A A A A A A A A A A A A A A A A A A A
B B B B B B B B B B B B B B B B B B B B B
C C C C C C C C C C C C C C C C C C C C C
どのように設定すれば
A A A A A A A
A A A A A A A
A A A A A A A
B B B B B B B
B B B B B B B
B B B B B B B
C C C C C C C
C C C C C C C
C C C C C C C
になるのでしょうか？
大変お手数ですが、ご教授よろしくお願いいたします。m(_ _)m
|
|
紅ほっぺ
- 09/4/16(木) 14:16 -
