| |
教えてください。
環境は、Windows10 Enterprise （ビルド1607） Excel2016 です。
1つのフォルダに100を超える数のエクセルブックがあり、それぞれのブックの中には複数のワークシートがあります。
全ブックから、シート名に 「Sheet」 と付くワークシート（Sheet1・Sheet10など）の2行目だけを抜き出して、別の集計用ブックにまとめるマクロを作成する必要があります。
前任者が作成したvbaで、複数ブックの 「Sheet1」 の2行目だけを抜き出すマクロはあるのですが、これをアレンジしてなんとかならないでしょうか？
Sub アンケート集計実行()
Dim wbn As Workbook
Dim wb As Workbook
Dim tb As Workbook
Dim TotalDir As String
Dim TotalSheet As String
Dim TargetSheet As String
Dim TargetFile As String
Dim TargetRow As String
Dim StartRow As String
Dim LastRow As String
Dim modeFlag As Boolean
'====================================================
' 値の設定
'====================================================
' 集計対象フォルダの指定
TotalDir = "C:\アンケート集計"
' 集計対象シートの指定
TargetSheet = "Sheet1"
' 集計用シートの指定
TotalSheet = "集計"
' 集計対象行の指定
TargetRow = "2"
' 集計結果記載開始行を指定
StartRow = "2"
' 追記するかしないかフラグ(True : 追記する、False: 追記しない)
modeFlag = False
'====================================================
' 実処理
'====================================================
Set tb = ThisWorkbook
If modeFlag = False Then
LastRow = tb.Sheets(TotalSheet).Rows(Rows.Count).End(xlUp).Row + 1
tb.Sheets(TotalSheet).Range(StartRow & ":" & LastRow).Delete
End If
TargetFile = Dir(TotalDir & "\*.xlsx", vbNormal)
Do While TargetFile <> ""
If TotalDir & "\" & TargetFile <> TotalFile Then
For Each wbn In Workbooks
If wbn.Name = TargetFile Then
MsgBox TargetFile & " は、既に開かれています。" & vbCrLf & "集計処理を中止します。"
Exit Sub
End If
Next wbn
Set wb = Workbooks.Open(TotalDir & "\" & TargetFile)
LastRow = tb.Sheets(TotalSheet).Rows(Rows.Count).End(xlUp).Row + 1
' 行ごとのコピーを行うとなぜかずれるので値のみコピーしてみる。
wb.Sheets(TargetSheet).Rows(TargetRow).Copy
tb.Sheets(TotalSheet).Rows(LastRow).PasteSpecial (xlPasteValues)
' クリップボード警告対策
tb.Sheets(TotalSheet).Range("A1").Copy
' 集計対象ファイルを閉じる
wb.Close False
End If
TargetFile = Dir()
Loop
' クリップボード警告対策
tb.Sheets(TotalSheet).Range("A1").Copy
' 集計ファイルを保存
tb.Save
' 集計後のファイルを閉じる
' tb.Close True
' 完了を通知
MsgBox "集計を完了しました。"
End Sub
あるいは、別の方法でも結構ですので、お知恵をお貸しいただけますと幸いです。
どうぞよろしくお願いいたします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
