[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ネットワーク内のフォルダのブックの統合』(pepsiman)
ネットワーク内のフォルダに有るブック(約20個)の一つのシートをデータ行を、1つの新規ブックにまとめたいと思っています。
過去の質問[[20100220200243]]を参考にし、作成していたのですが、VBA初心者の為いまいち理解出来ず…
分かる方の知恵をお借りできればと思い、こちらにて質問させて頂きました。
・ネットワーク内のフォルダに有るブックは3行目からデータ行となっており、行数・列数はまちまち
・ネットワーク内のフォルダに有るブックはそれぞれ1つしかシートがありません。
・項目はA列からM列くらいまでコピーしたいと考えています。(項目の並びは同じで、いくつかのブックは項目数が多いですが、最大でM列くらいまでしかデータは無いのでM列までコピー出来れば問題ないかと思います。)
・フォルダ内にはxls、xlsxの双方があり、どちらも1シートに統合し、DBブックとして保存したいです。
宜しくお願い致します。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
こんなのを動かしてみたらどうなりますか?
'------ Sub ブックを統合02() Dim seDir As String, myDir As String, myFileName As String Dim wb As Workbook, ws As Worksheet Dim mxRow As Long, myRow As Long With ActiveSheet If MsgBox("処理を開始します。現在のシートのデータは削除されます。", _ vbOKCancel + vbExclamation) = vbCancel Then Exit Sub End If With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then seDir = .SelectedItems(1) End If End With If seDir = "" Then MsgBox "処理を中止します。" Exit Sub End If .Range("4:" & Rows.Count).Clear 'Application.ScreenUpdating = False myDir = seDir & "\" myFileName = Dir(myDir & "*.xls") Do While myFileName <> "" Set wb = Workbooks.Open(myDir & myFileName) Set ws = wb.Sheets(1) mxRow = ws.Range("A" & Rows.Count).End(xlUp).Row If mxRow > 2 Then If myRow = 0 Then .Range("A1").Value = "ブック名" ws.Range("A1:M1").Copy .Range("B1") End If .Range("A" & myRow + 1).Resize(mxRow - 2, 1).Value = Mid(myFileName, 1, Len(myFileName) - 4) ws.Range("A2:M" & mxRow).Copy .Range("B" & myRow + 1) myRow = myRow + mxRow - 2 End If wb.Close False myFileName = Dir Loop .Range("B2:B" & mxRow).Copy .Range("A2").PasteSpecial Paste:=xlPasteFormats .Range("A1").Select Application.CutCopyMode = False 'Application.ScreenUpdating = True End With End Sub '------
動かしてみてないので、よく確認して 問題個所を教えて下さい。 (HANA) 2014/09/21(日) 14:00
お手数ですが、宜しくお願い致します。
(pepiman) 2014/09/25(木) 16:31
まずは >各ブックの3行目からデータを抽出したい >xlsxブックの抽出が出来ていないようです。 の2点に関してですが .Range("A" & myRow + 1).Resize(mxRow - 2, 1).Value = Mid(myFileName, 1, Len(myFileName) - 4) ws.Range("A2:M" & mxRow).Copy .Range("B" & myRow + 1) の所を .Range("A" & myRow + 1).Resize(mxRow - 2, 1).Value = myFileName ws.Range("A3:M" & mxRow).Copy .Range("B" & myRow + 1) にしてやって結果をかくにんしてみてもらえますか?
A列にブック名が、拡張子まで含めて入る様になっています。 xlsブックもxlsxブックも 混ざって抽出されると思いますが。 (HANA) 2014/09/25(木) 16:39
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.