[[20140409215610]]　『原本ファイルへのデータの自動集積』（かまなん）　ページの最後に飛ぶ

『原本ファイルへのデータの自動集積』（かまなん）

エクセルのマクロ？に関して質問です。
ほぼマクロに関しては初心者でございます。
エクセルでデータの集計を行っております。

各自同じ形式のファイルに記入してもらい、メールで送付して頂き、
その集めたデータを形式は同じ別ファイルのシートにデータを集積していく形で集めているのですが、
マクロ？を組んでボタン一つで集めることは可能でしょうか。

イメージとしては
送られてきたA’ファイルのデータの中で(4つのシートで項目別にしております)各シート新たに記入してある部分のみ取り出し、
(以前のデータは削除し、毎回同じA'ファイルに記入して頂いております)
原本であるAファイルにどんどん追加していくイメージです。

ファイル名：共有原本(蓄積するファイル)
ファイル名：記入表(記入していただくファイル)

シート名ですが、共有原本、記入表ともに
シート1：作業１
シート2：作業２
シート3：作業３
シート4：作業４

セルの範囲ですが
共有原本に関して
作業１：B6からH6の7つのセル
作業２：B23からD23の3つのセル
作業３：B11からH11の７つのセル
作業４：B10からF10の5つのセル
以上の列から始まり、どんどん追加していく様にしていのです。

記入表ファイルでは作業１～４まで共通して
行は固定ですが、毎回どの列まで記入されるかはわかりません。
記入された所までを判別し、共有原本のファイルに追加していくことは可能でしょうか。

共有原本の列に関してはデータがある限り追加していきたいと考えておりますので上限を考えておりません。
仮に上限が必要でしたら1000で設定お願いできますでしょうか。

解り難い文章で大変申し訳ございませんが宜しくお願い申し上げます

＜使用 Excel：Excel2007、使用 OS：WindowsVista ＞

 ファイルというのはメールに添付された状態を想定しているのでしょうか。
 それとも、あるフォルダに保存した後、もしくは EXCEL で開いた状態での処理を
 想定しているでしょうか。

 前者であれば、ちょっと（？）敷居は高くなります。
 その際も VBA で処理するのであれば使用しているメールソフトが Outlook で
 あるほうが楽ですがそのあたりはどうでなのでしょうか。
（Mook） 2014/04/10(木) 19:25

ご回答誠にありがとうございます。
メールに添付された状態でも可能だとは想定しておりませんでした。
メールソフトはOutlookを使用しております。

共有原本と同じフォルダにあることを想定しております。

（かまなん） 2014/04/11(金) 03:29

 ではとりあえず、フォルダ内のファイル処理前提で。
 こんな感じのことでしょうか。

'// 要設定：ツール ⇒ 参照設定 ⇒ 「Microsoft Scripting Runtime」にチェック

 Public fso As New Scripting.FileSystemObject

 '-----------------------------------------------------------------------
 Sub データ追加()
 '-----------------------------------------------------------------------
    For Each ファイル In fso.GetFolder(ThisWorkbook.Path).Files
        If InStr(UCase(fso.GetExtensionName(ファイル.Path)), "XLS") > 0 And InStr(ファイル.Name, "~$") = 0 Then
            If ファイル.Name <> ThisWorkbook.Name Then
                ファイルデータ追加 ファイル.Path
            End If
        End If
    Next
 End Sub

 '-----------------------------------------------------------------------
 Sub ファイルデータ追加(ファイルパス)
 '-----------------------------------------------------------------------
    Dim コピー元WS As Worksheet
    With Workbooks.Open(ファイルパス)
        For Each コピー元WS In .Worksheets
            Select Case コピー元WS.Name
            Case "作業1": シートデータ追加 コピー元WS, 6, "H"
            Case "作業2": シートデータ追加 コピー元WS, 23, "D"
            Case "作業3": シートデータ追加 コピー元WS, 11, "H"
            Case "作業4": シートデータ追加 コピー元WS, 10, "F"
            End Select
        Next
        .Close False
    End With
 End Sub

 '-----------------------------------------------------------------------
 Sub シートデータ追加(コピー元WS As Worksheet, 開始行 As Long, 最終列 As String)
 '-----------------------------------------------------------------------
    Const 開始列 = "B"

    Dim コピー先WS As Worksheet
    Set コピー先WS = ThisWorkbook.Worksheets(コピー元WS.Name)

    Dim コピー先最終行 As Long
    コピー先最終行 = コピー先WS.Cells(Rows.Count, 開始列).End(xlUp).Row + 1
    If 開始行 > コピー先最終行 Then コピー先最終行 = 開始行

    Dim コピー元最終行 As Long
    コピー元最終行 = コピー元WS.Cells(Rows.Count, 開始列).End(xlUp).Row

    If コピー元最終行 < 開始行 Then Exit Sub

    Dim コピー範囲 As Range
    Set コピー範囲 = コピー元WS.Range(コピー元WS.Cells(開始行, 開始列), コピー元WS.Cells(コピー元最終行, 最終列))

    コピー範囲.Copy コピー先WS.Cells(コピー先最終行, 開始列).Resize(コピー範囲.Rows.Count, コピー範囲.Columns.Count)
 End Sub

（Mook） 2014/04/11(金) 12:38

ご回答誠にありがとうございます。
Mookさんのご回答をもとにチャレンジしてみます。
ありがとうございます!!
（かまなん） 2014/04/11(金) 16:10

コメント返信：

[ 一覧(最新更新順) ]

[[20140409215610]] 『原本ファイルへのデータの自動集積』（かまなん） ページの最後に飛ぶ

[[20140409215610]]　『原本ファイルへのデータの自動集積』（かまなん）　ページの最後に飛ぶ