教えて! goo のコンテンツに対する取り組みについて

初めまして

VBAでダイアログボックスで選択したフォルダ内の、EXCLEファイル名とシート名一覧を出すものを作りました。
画像のようにシート名をクリックするとそのシートをコピーしたいと考えています。
上記の事は出来ますでしょうか。出来るなら教えていただきたいです。
よろしくお願い致します。


下記コードです。

Sub 検索()
Dim fn(10000) 'フォルダ内ファイル名
Dim sn(10000, 2) 'フォルダ内エクセルファイル名、シート名
Dim i As Long, j As Long, k As Long, x As Long
Dim mypath As String 'フォルダパス
Dim ext As String '拡張子検索変数


'フォルダの選択
With Application.FileDialog(msoFileDialogFolderPicker) 'ダイアログ表示
.Title = "フォルダを選択"
.AllowMultiSelect = False
If .Show = -1 Then
mypath = .SelectedItems(1) 'パス取得
Else
Exit Sub
End If
End With

Application.ScreenUpdating = False '画面更新非表示

'ファイル名の取得
fn(1) = Dir(mypath & "\", vbDirectory)
i = 1
Do
i = i + 1
fn(i) = Dir

Loop Until fn(i) = ""


'シート名の取得
x = 0
For j = 1 To i - 1
ext = Mid(fn(j), InStrRev(fn(j), ".") + 1, 3) '拡張子取得
'エクセルファイルの時実行
If ext = "xls" Then
Workbooks.Open Filename:=mypath & "\" & fn(j)
For k = 1 To Sheets.Count
sn(x, 1) = fn(j) 'エクセルファイル名取得
sn(x, 2) = Sheets(k).Name 'シート名取得

x = x + 1
Next k
ActiveWorkbook.Close
End If
Next j




'シート名一覧の作成
Columns("A:B").Select
Selection.ClearContents
Cells(2, 1) = "作業フォルダ"
Cells(3, 1) = mypath
Cells(4, 1) = "ファイル名"
Cells(4, 2) = "シート名"
x = 0
Do
Cells(x + 5, 1) = sn(x, 1)
Cells(x + 5, 2) = sn(x, 2)
x = x + 1
Loop Until sn(x, 1) = ""



Range("A1").Select

Application.ScreenUpdating = True '画面更新表示

MsgBox "完了しました"

End Sub

「EXCLE VBA シートクリックしたら」の質問画像
gooドクター

A 回答 (1件)

こんばんは、


貼り付け先がしていないと言う事はコピーしたシートがある新規ブックを作るで良いのでしょうか、、、
何れに致しましてもシングルクリックではイベントが無いので
ダブルクリックイベントを使うのが良いのでは無いかと思います。
書き出したシートモジュールに
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim fn As String, bk As String, pth As String
pth = Range("A3").Value
bk = Target.Offset(, -1).Value
fn = Target.Value
With Workbooks.Open(pth & "\" & bk)
.Sheets(fn).Copy

End With
Cancel = True
End Sub

Sheets(k).Nameで取得しているのでWorksheetsは使いませんでした。

書き出したのだからないと言う事は無いと思いますが、表組みが変わると
エラーが返る可能性がありますので対処してください。

ブックを作らないのなら、Destinationでコピー先オブジェクトを指定してください。
    • good
    • 0
この回答へのお礼

返信遅くなりすみません、やりたい事できました!言葉足らずですみません。
教えていただき、ありがとうございます!!

お礼日時:2021/11/11 22:57

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

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

gooドクター

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

人気Q&Aランキング