「夫を成功」へ導く妻の秘訣 座談会

同じフォルダ内に、エクセルファイルがいくつかあります。
そのフォルダ内のファイルから、特定のシート名(例:シートA)のシートをコピーしシートAだけの新しいファイルとして作成しようと思います。

シートAを含むファイルは複数あります。
何か方法がありましたらご教授お願いいたします。

A 回答 (2件)

取りまとめるブック名を『統合.xls』とします。



Sub Sample()
On Error Resume Next

Dim TSheet As String
TSheet = Dir(ThisWorkbook.Path & "\*.xls", vbNormal)
Do While TSheet <> ""
If TSheet <> "統合.xls" Then
Workbooks.Open (ThisWorkbook.Path & "\" & TSheet)
ActiveWorkbook.Sheets("シートA").Copy after:= _
Workbooks("統合.xls").Sheets(1)
Workbooks(TSheet).Close
End If
TSheet = Dir()
Loop
End Sub

必要な箇所は適宜変更して下さい。

また、実行する際はフォルダのバックアップは必ず取ってください。

元ファイルは開くだけなので壊すことは無いと思いますが念の為です。
    • good
    • 1
この回答へのお礼

keirikaさん、どうもありがとうございます。
望んでいたものとドンピシャです!

お礼日時:2008/06/24 21:06

良くある質問と思いますが、この質問タイトルは、後々他の方の役に立つ良い名前の付け方ですね。


方法1:人力で地道に行う
方法2:マクロで行う
過去に回答したコードを、特定の名前のシートだけコピーする様に変更しました。同じ名前のシートを複数コピーするので、ファイル名に付け替えています。新しいブックにではなく、このマクロのあるブックに収集します。XL2000のコードです。
Sub treatAllFiles()
Dim FSO As Object
Dim folderName As String
Dim targetFolder As Object
Dim targetFiles As Object
Dim targetFile As Object
Dim sh As Worksheet

'フォルダー名は環境に合わせる事
folderName = "C:\Documents and Settings\?????\My Documents\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set targetFolder = FSO.getfolder(folderName)
Set targetFiles = targetFolder.Files
For Each targetFile In targetFiles
DoEvents '途中でやめたくなった時のための保険
If UCase(Right(targetFile, 4)) = ".XLS" Then
Application.Workbooks.Open Filename:=targetFile, UpdateLinks:=False
For Each sh In Application.ActiveWorkbook.Worksheets
If sh.Name = "特定のシート名" Then
sh.Copy Before:=ThisWorkbook.Sheets(1)
ActiveSheet.Name = FSO.GetBaseName(targetFile)
End If
Next
Windows(FSO.GetFileName(targetFile)).Activate
Call ActiveWorkbook.Close(savechanges:=False)
End If
Next targetFile
End Sub
    • good
    • 2
この回答へのお礼

mitarashiさん
希望していた通りの結果になりました。
ありがとうございます!
タイトルをお褒めいただき恐縮です。

お礼日時:2008/06/24 21:08

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

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

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

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

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複数エクセルから特定シートの特定行だけを別シートに抽出するマクロ

エクセルブックが160ほどあります。
それらは全て同じ作りで、シートが2つづつ存在しています。
その2シート目(シート名”集約”シート)にある特定のセル(A2からT2)だけを
別のエクセルに集めて一覧にしたいです。

色々とやってみてネット検索もしてみたのですが、うまくいかないので
どなたか教えていただけませんでしょうか。

Aベストアンサー

こんな感じで、どうでしょう。
MyPathで指定したフォルダ内の .xlsx ファイルを対象に一覧化します。
一覧は、A列にファイル名、B列以降に各ブック中の”集約”シートのA2~T2が表示されます。
ただし、”集約”シートが無い場合は、ちょっとおかしな動作をします。おかしな動作については、お楽しみ!!(元のファイルが壊れることは無いので、安心して実行してみて下さい)

Sub sample()
Dim MyPath As String
Dim MyFile As String
Dim I As Long
MyPath = "C:\教えてGoo\"
MyFile = "*.xlsx"
MyFile = Dir(MyPath & MyFile)
Do While MyFile <> ""
I = I + 1
Cells(I, "A") = MyFile
Range(Cells(I, "B"), Cells(I, "U")).Formula = "='" & MyPath & "[" & MyFile & "]Sheet1'!A2"
MyFile = Dir
Loop
End Sub

こんな感じで、どうでしょう。
MyPathで指定したフォルダ内の .xlsx ファイルを対象に一覧化します。
一覧は、A列にファイル名、B列以降に各ブック中の”集約”シートのA2~T2が表示されます。
ただし、”集約”シートが無い場合は、ちょっとおかしな動作をします。おかしな動作については、お楽しみ!!(元のファイルが壊れることは無いので、安心して実行してみて下さい)

Sub sample()
Dim MyPath As String
Dim MyFile As String
Dim I As Long
MyPath = "C:\教えてGoo\"
MyFile = "*.xlsx"...続きを読む

Qエクセル:シート名を手入力でなく、セル「A1」の文字を出したい。

いつもお世話になります。
エクセルのシート名についての質問です。
いつもはシート名を変えるとき、シートタブの上を右クリックして「変更」しています。

◆そこで、
(1) セル「A1」に入力されてある文字を自動で出す
(2) もしくはマクロボタンを押すと「A1」に入力されてあるものが「シート名」として変わる

というようにしたいのですが、その方法について教えてください。よろしくお願いいたします。

Aベストアンサー

こんにちは。


(1)の場合は、下記のコードを ThisWorkbook に記述してください。
どのワークシートでも機能します。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value
End Sub


(2)場合は、下記のコードを標準モジュールに記述しボタンにマクロ登録してください。
(すべてのシートにボタンを貼り付けるのは面倒でしょうから、ツールバーにボタンとして追加すると良いと思います。)

Public Sub SheetName()
ActiveSheet.Name = Range("A1").Value
End Sub

QエクセルVBAでフォルダ内の全ファイルをコピペ

フォルダ内にあるファイルの内、複数を指定して開いて、任意の部分をコピーし、マスターとなるファイルに貼りつける、という作業をVBAで行いたいと思っています。
VBAを全く知らないため、毎回20近いファイルを手で開いてはコピペしなくてはならず困っております。
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペしたいです。
●マスターも同じく10行目まではタイトル欄なので、11行目以降に、他ファイルの11行目以降の内容をどんどん積み上げていく形式にしたいです。
●ファイルの名前は毎回変わるので、フォルダ内の指定されたエクセルファイルのみをコピペ、のような処理にしたいです。
●B列だけは必ず記載がある列なので、そこを参考に11行目から何行目までをコピーすればいいのかを判断できるのかな、と思います。
●貼り付けが完了したらマスター以外の開いたファイルを全て閉じるところまで自動化できたら有難いです。
全くの初心者なため、貼り付けるだけで動くようなものをいただけれると大変助かります。
よろしくお願いいたします。

フォルダ内にあるファイルの内、複数を指定して開いて、任意の部分をコピーし、マスターとなるファイルに貼りつける、という作業をVBAで行いたいと思っています。
VBAを全く知らないため、毎回20近いファイルを手で開いてはコピペしなくてはならず困っております。
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペしたいです。
●マスターも同じく10行目まではタイトル欄なので、11行目以降に、他ファイ...続きを読む

Aベストアンサー

>全くの初心者なため、貼り付けるだけで動くようなものをいただけれると大変助かります。
そこまで甘えないことが上達の早道です。

同じような質問が良くありますよ。最近回答した質問ですが
http://oshiete.goo.ne.jp/qa/7578876.html
http://oshiete.goo.ne.jp/qa/4221547.html
を参考にしてみてください。とは云っても少し、説明しておきますと
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペしたいです。
Sheets("Sheet1").Range("A1:J1000").Copy
の部分が Sheets("Sheet1").Range("A11:J1000").Copy
にすると、11行目からJ1000までに という事になります。
デーやが入っている最終の行を取得する方法はありますが、データを元データの行数がたいしたことなければ

元データが最大1000行までであれば
Range("A1:J1000").Copy
と指定しても、空白がコピーされるだけですので十分ではあります。

●マスターも同じく10行目まではタイトル欄なので、11行目以降に、他ファイルの11行目以降の内容をどんどん積み上げていく形式にしたいです。
Range("A65536").End(xlUp).Offset(1, 0).Select
がA列の最終の行から上へ検索してデータの入っている行の下を探しています。

●ファイルの名前は毎回変わるので、フォルダ内の指定されたエクセルファイルのみをコピペ、のような処理にしたいです。
Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
で指定したフォルダのエクセルファイルを順に取得しています。

●B列だけは必ず記載がある列なので、そこを参考に11行目から何行目までをコピーすればいいのかを判断できるのかな、と思います。
Range("A65536").End(xlUp).Offset(1, 0).Select

Range("B65536").End(xlUp).Offset(1, 0).Select
とするとB列の最終行を取得できます。
*但し、B65536 はエクセル2003以前のヴァージョンの最大65536行なので、この様になっています。
エクセル2007以上であれば、 65536 の値が異なります。
バージョンを問わずという事であれば、最終の行を取得する方法があります。


●貼り付けが完了したらマスター以外の開いたファイルを全て閉じるところまで自動化できたら有難いです。
Workbooks(buf).Close SaveChanges:=False
の部分が、上書き保存せずに 閉じる という事です。
更に検討が必要な部分としては、貼り付けの作業を行った後のファイルをどうするかです。
そのままでは、VBAを実行するたびにデータが追加されますしね。
解決案
コピーが終了したら、ファイルごと削除、ほかのフォルダーへ移動させる。

或いは、
データの部分(11行目以下)を削除して保存していく。

或いは、
VBA実行前に、マスターのデータをクリアして、毎回、全てのファイルのデータを
貼り付ける。

とりあえず、ここまでにしておきます。

>全くの初心者なため、貼り付けるだけで動くようなものをいただけれると大変助かります。
そこまで甘えないことが上達の早道です。

同じような質問が良くありますよ。最近回答した質問ですが
http://oshiete.goo.ne.jp/qa/7578876.html
http://oshiete.goo.ne.jp/qa/4221547.html
を参考にしてみてください。とは云っても少し、説明しておきますと
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペし...続きを読む

QExcel VBAで複数シートをコピーする

Excel VBAで複数のシートを新たらしいブックにコピーする方法が分かりません。

一応、Selectで全てのシートを選択し
コピーする方法は分かるのですが
出来ればSelectなどの画面遷移をプログラム内に含ませたくありません

シートは n件存在します。
ご存知の方がおられましたら
ぜひ、教えて頂けないでしょうか?

Aベストアンサー

すいません、勉強不足でした。
ただ単純に「全てのシートを選択」し「新規ファイルにコピー」という動作であれば、
sheets.Select
sheets.Copy
だけでできました。

Qある範囲のセルから任意の値を検索して、その隣のセルの値を取得するという関数はありますか?

Excelの関数について質問します。
ある範囲のせるを検索して、その隣のセルの値を取得するという関数を探しています。
なければユーザー定義で作りたいと思っています。
VLOOKUP関数では一番左端が検索されますが、
それをある範囲まで拡張して、
その右隣の値を取得できるようにしたいのです。
どうかお知恵をお貸しください。

Aベストアンサー

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場合によっては、IFをかぶせてCOUNTIFで確認した方が良いかもしれません。
 ex. =IF(COUNTIF(A1:F200,X1)=1,【上記数式】,"えらー")

ちなみに、VBAでやるならこんな感じになるかと。

動作の概要
 【検査範囲】から【検査値】を探し、
 最初にHITしたセルについて、右隣のセルの値を返す。
 ex. =Sample(X1,A1:F200)

'--------------------------↓ココカラ↓--------------------------
Function Sample(ByVal 検査値 As Variant,ByVal 検査範囲 As Range)
 For Each セル In 検査範囲
  If セル = 検査値 Then Exit For
 Next セル
 Sample = セル.Offset(0, 1)
End Function
'--------------------------↑ココマデ↑--------------------------

いずれもExcel2003で動作確認済。
以上ご参考まで。

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場...続きを読む

Q複数のブックからデータを転記するマクロについて

こんにちは。
VBAの素人なのでネットや本などで自分なりに調べましたが、
どうにも解決できないので、ご教示いただけませんでしょうか。

複数のブックにある同一セル番地にある
データを別のブックにまとめたいのですが、
ブック数が500程度あり、マクロでうまくできないか悩んでいます。

 (1)転記元ブックを開く。
 (2)転記元データをコピーする。
 (3)転記先ファイルのセルに貼り付ける。
 (4)転記元ブックを閉じる。
の繰り返しだと思うのですが、(2)ができず困っています。
ちなみに、500のブックとまとめるブックも同じフォルダにあります。

具体的には、転記元ブックは以下のような形で、A列に様々な温度のデータが縦に並んでいます。
   A列  
1行  温度 
2行  27 ←ここのみ抽出したい
3行  28
4行  30

それぞれのブックのA2番地の温度データのみを抽出し、転記先ブックのA2からA500までまとめたい。

組んだマクロは以下です。
------------------------------
Sub 特定フォルダ内ブックを並べ替えて転記()
Dim myDir As String, myName As String, myBook As Workbook
Dim motodata As Range, sakidata As Range

  '集計用のブックがあるフォルダ名を指定
myDir = "D:\VBA練習"
myName = Dir(myDir & "\" & "*.xls")

  Do While myName <> ""
  '↓転記先の最新レコード位置を取得する
  Set sakidata = Range("A65536").End(xlUp).Offset(1)
  '↓(1)指定した名前のブックを開いて変数に格納する
 Set myBook = Workbooks.Open(Filename:=myDir & "\" & myName)
  '↓(2)転記元を取得する
  Set motodata = myBook.Range("A2")
     '↓(3)転記先に貼り付ける
  motodata.Copy sakidata
  '↓(4)開いたブックを閉じる
  myBook.Close
 myName = Dir()
 Loop
End Sub
------------------------------
mybookというキーワードを使用して、A2セルデータをコピーする構文をご教示いただけませんでしょうか。

以上、長々となってしまいましたが、何卒アドバイスの程お願いいたします。

こんにちは。
VBAの素人なのでネットや本などで自分なりに調べましたが、
どうにも解決できないので、ご教示いただけませんでしょうか。

複数のブックにある同一セル番地にある
データを別のブックにまとめたいのですが、
ブック数が500程度あり、マクロでうまくできないか悩んでいます。

 (1)転記元ブックを開く。
 (2)転記元データをコピーする。
 (3)転記先ファイルのセルに貼り付ける。
 (4)転記元ブックを閉じる。
の繰り返しだと思うのですが、(2)ができず困っています。
ちなみに、500...続きを読む

Aベストアンサー

複数のBookやSheetの処理をする場合
#1さんも言われてるように、Book、Sheetを省略すると
現在アクティブになっている、Book、Sheetを指定したことになってしまいます
一応、修正してみましたが
Sheet名が不明なため"ActiveSheet"としていますが
複数Sheetがある場合、希望どおりの結果を得られない可能性があるので
"workheet("処理対象シート名")"に変更した方がよいと思います


Sub 特定フォルダ内ブックを並べ替えて転記()
Dim myDir As String, myName As String, myBook As Workbook
Dim motodata As Range, sakidata As Range

Dim 転記先 As Worksheet, 転記元 As Worksheet

Set 転記先 = ThisWorkbook.ActiveSheet

'集計用のブックがあるフォルダ名を指定
myDir = "D:\VBA練習"
myName = Dir(myDir & "\" & "*.xls")
Do While myName <> ""
'↓転記先の最新レコード位置を取得する
Set sakidata = 転記先.Range("A65536").End(xlUp).Offset(1)
'↓(1)指定した名前のブックを開いて変数に格納する
Set myBook = Workbooks.Open(Filename:=myDir & "\" & myName)
'↓(2)転記元を取得する

Set 転記元 = myBook.ActiveSheet

Set motodata = 転記元.Range("A2")
'↓(3)転記先に貼り付ける
motodata.Copy sakidata
'↓(4)開いたブックを閉じる
myBook.Close
myName = Dir()
Loop
End Sub

参考まで

複数のBookやSheetの処理をする場合
#1さんも言われてるように、Book、Sheetを省略すると
現在アクティブになっている、Book、Sheetを指定したことになってしまいます
一応、修正してみましたが
Sheet名が不明なため"ActiveSheet"としていますが
複数Sheetがある場合、希望どおりの結果を得られない可能性があるので
"workheet("処理対象シート名")"に変更した方がよいと思います


Sub 特定フォルダ内ブックを並べ替えて転記()
Dim myDir As String, myName As String, myBook As Workbook
Dim moto...続きを読む

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

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
問題は、「同一フォーム」の内容ですね。
データ中に各支店名が含まれていなければ、抽出時に付与しないと訳が分からなくなるし、
変に凝った様式だと単純にコピーするだけではうまくいかないし。

QエクセルVBA 別シートの複数のセルの値をコピーする方法

いつもお世話になります。

Dim sh1, sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")

sh1.Range("C6").Value = sh2.Range("F5").Value
として、1つのセルの値ならコピーできるのですが、
sh1.Range("C6:C10").Value = sh2.Range("F5;F9").Value
としても、セルの値を持ってくることができません。
どのように書けば良いのでしょうか?

ちなみに今は、
sh2.Range("F5:F9").Copy
sh1.Range("C5:C9").PasteSpecial Paste:=xlValues
としているのですが、上記だとセルを範囲指定してしまって作業が見えるのでカッコ悪いのです。

Aベストアンサー

7-samuraiの質問ですみません。
No5のimogasiさん、いつもお世話様です。

Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet2")
Set sh2 = Worksheets("sheet1")
sh1.Range("c1:c5").Value = sh2.Range("A1:A5").Value
End Sub

で、うまくいきますよ。
複数セルの場合Valueは省略できないようです。


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

人気Q&Aランキング