エクセルVBAに関しての質問です。

質問

エクセルVBAに関しての質問です。

同じフォルダ内に同形式のエクセルファイルが複数あります。そのファイルの特定のシートの中の特定の列のみをコピーして並べたいと思っています。

(1)フォルダはUSBに入れて使ったり、複数のパソコンの中で使われるので特定の場所にあるとは限りません。
(2)フォルダ名はその年度に応じて変更されます。「2009」、「2010」・・・といった具合です。
(3)フォルダ内のファイル数は常に３つで、「記録集計第1期」「記録集計第2期」「記録集計第3期」と名前を付けています。
(4)３つのファイル全てに「結果」という名前のシートがあり、そのシートのC4～AU37までのセルをコピーしたいです。
(5)C4～AU37までのセルには数値では無く、IF関数を使用して出された「◎」「◯」「△」等の文字列が入っています。
(6)コピーしたセルを「記録集計第3期」ファイルの中の「年度末結果」というシートのC2以降に並べてコピーしたいです。
「記録集計第1期」のC4～AU37を「年度末結果」のC2~AU35へ
「記録集計第2期」のC4～AU37を「年度末結果」のAV2~CN35へ
「記録集計第3期」のC4～AU37を「年度末結果」のCO2~EG35へ
といった具合です。
(7)作業手順としては、「記録集計第3期」のファイルを開き、その中の「年度末結果」のシートにボタンを作って上記のVBAを動かせたらと思っています。
(8)「記録集計第1期」「記録集計第2期」のファイルは開かずにデータをコピーしたいです。

勝手なお願いで申し訳ございませんが、
お時間がございましたら、よろしくお願いいたします。

回答No.4

ka_na_de · ベストアンサー

こんにちは。

あと一息ですね。

A列B列が消えてしまう件ですが、
　　ThisWorkbook.Worksheets("年度末結果").Cells.Clear
の行で、「年度末結果」シート上のセルを最初に全てクリアしています。

ここを消すか、先頭に'を付けてコメントにすれば大丈夫です。

もし、ある特定のセルをクリアしたければ、
　　ThisWorkbook.Worksheets("年度末結果").Range("C2:F9").Clear
にすれば良いです。
列クリアなら
　　ThisWorkbook.Worksheets("年度末結果").Columns("C:F").Clear
などにしてください。

お礼

何から何まで本当にありがとうございました。

完璧です！！
すごいです！！

これをきっかけにVBAを勉強してみたくなりました。
色々とお世話になりました。
ありがとうございました。

回答No.3

ka_na_de

＃１、＃２です。

大事なことを忘れていました。
私のコードはエクセル2003以前を対象とした作りになっています。

もし、エクセル2007を使っているのであれば、
ファイルの拡張子が[.xls]ではなく[.xlsx]になっていますので、

　　　myWbName = "記録集計第" & i & "期.xls"
を
　　　myWbName = "記録集計第" & i & "期.xlsx"
に変更してください。

お礼

はじめまして、ka_na_deさん。

何度も御丁寧に教えて頂き、本当にありがとうございます。

同じような例が無いかと検索ばかりしていたのですが、
やはり、そう簡単には解決法も見つからず、
あきらめかけていましたが、
こんなに親切に教えて頂けて、本当に本当に感謝しております。

早速、明日にでもチャレンジしてみたいと思います。
ありがとうございました。

補足

ka_na_deさん、すみません。

実際にやってみたのですが、
コピー先のシート『年度末結果』のC2以降へのコピーは完璧だったのですが、
元々入っていたA列とB列の文字が全て消えてしまっていました。

解決できますでしょうか？
甘えてばかりですみません。

お時間がございましたら、教えてくださいませ。

追伸：この文章をお礼のところに書き加えたかったのですが、
補足入力の所で書かせて頂きました。

回答No.2

ka_na_de

＃１です。

不具合がありましたので修正します。
＜不具合内容＞
　例えば、「2009」のフォルダーの中の「記録集計第3期」にて
　年度末結果を出力しようとした際、「2008」のフォルダーの
　中の「記録集計第1期」や「記録集計第2期」が既に開いていた場合、
　「2009」ではなく「2008」のファイルの値をコピーしてしまう。
＜変更点＞
　「記録集計第1期」や「記録集計第2期」が開いている場合は、
　　一旦閉じてから再実行するように警告を出すようにしました。

Sub Test2()
　　Dim i As Long
　　Dim flg As Boolean
　　Dim myWb As Workbook
　　Dim myWbName As String

　　Application.ScreenUpdating = False

　　ChDrive ThisWorkbook.Path
　　ChDir ThisWorkbook.Path

　　ThisWorkbook.Worksheets("年度末結果").Cells.Clear

　　For i = 1 To 3
　　　　flg = False
　　　　myWbName = "記録集計第" & i & "期.xls"
　　　　If myWbName <> ThisWorkbook.Name Then
　　　　　　For Each myWb In Workbooks
　　　　　　　　If myWb.Name = myWbName Then flg = True
　　　　　　Next myWb
　　　　　　If flg = False Then
　　　　　　　　Workbooks.Open Filename:=myWbName
　　　　　　Else
　　　　　　　　Workbooks(myWbName).Activate
　　　　　　　　MsgBox myWbName & "を閉じてから再実行してください。"
　　　　　　　　Exit Sub
　　　　　　End If
　　　　End If
　　　　Worksheets("結果").Range("C4:AU37").Copy
　　　　ThisWorkbook.Worksheets("年度末結果").Range("C2").Offset(, 45 * (i - 1)).PasteSpecial Paste:=xlPasteValues
　　　　If myWbName <> ThisWorkbook.Name Then
　　　　　　Application.DisplayAlerts = False
　　　　　　Workbooks(myWbName).Close SaveChanges:=False
　　　　　　Application.DisplayAlerts = True
　　　　End If
　　Next i
　　Application.CutCopyMode = False
　　Application.ScreenUpdating = True
End Sub

回答No.1

ka_na_de

こんばんは。

一例です。

＜注意＞
・ファイルを開いてから処理してます。
　VBAで開いたものは閉じて終了します。
・コピーの際は、値のみ貼り付けしてます。

Sub Test()
　　Dim i As Long
　　Dim flg As Boolean
　　Dim myWb As Workbook
　　Dim myWbName As String

　　Application.ScreenUpdating = False

　　ChDrive ThisWorkbook.Path
　　ChDir ThisWorkbook.Path

　　ThisWorkbook.Worksheets("年度末結果").Cells.Clear

　　For i = 1 To 3
　　　　flg = False
　　　　myWbName = "記録集計第" & i & "期.xls"
　　　　For Each myWb In Workbooks
　　　　　　If myWb.Name = myWbName Then flg = True
　　　　Next myWb
　　　　If flg = False Then
　　　　　　Workbooks.Open Filename:=myWbName
　　　　Else
　　　　　　Workbooks(myWbName).Activate
　　　　End If

　　　　Worksheets("結果").Range("C4:AU37").Copy
　　　　ThisWorkbook.Worksheets("年度末結果").Range("C2").Offset(, 45 * (i - 1)).PasteSpecial Paste:=xlPasteValues

　　　　If myWbName <> ThisWorkbook.Name And flg = False Then
　　　　　　Application.DisplayAlerts = False
　　　　　　Workbooks(myWbName).Close SaveChanges:=False
　　　　　　Application.DisplayAlerts = True
　　　　End If
　　Next i
　　Application.CutCopyMode = False
　　Application.ScreenUpdating = True
End Sub