シートを選んで内容を別なシートにコピーしたい

Question

今「結果.xlsm」でユーザーフォームを作成しております。
ユーザーフォームではリストボックスを２つ並べています。

一つ目のリストボックスでブックを選び、
二つ目のリストボックスでシートを選びます。
選んだシートの内容全てをコピーして
「結果.xlsm」の「データ」シートに貼り付けたいと思っています。

リストボックス１で
「氏名1」「氏名2」「氏名3」「氏名4」というブックを選択します。

リストボックス２で
それぞれのブックの中の「商品1～4」「商品11～17」「商品22～26」「商品33～40」からシートを選択します。

リストボックスを並べて商品名を選ぶところまではできたのですが、
そこから先に進めず困っておりました。

ここから先をどのように記述したら希望の動きになるか教えていただけませんでしょうか？
また、ブックやシートは固定ではなく増えたり減ったりします。
.AddItemで追加削除するのではなく、定義を追加する方法もあれば教えてください。

よろしくお願いいたします。

Private Sub UserForm_Initialize()
With ListBox1
.AddItem "氏名1"
.AddItem "氏名2"
.AddItem "氏名3"
.AddItem "氏名4"
.ListIndex = 0
End With
End Sub

Private Sub ListBox1_Click()
With ListBox2
.Clear
Select Case ListBox1.List(ListBox1.ListIndex)
Case "氏名1"
.AddItem "商品1"
.AddItem "商品2"
.AddItem "商品3"
.AddItem "商品4"
Case "氏名2"
.AddItem "商品11"
.AddItem "商品12"
.AddItem "商品13"
.AddItem "商品14"
.AddItem "商品15"
.AddItem "商品16"
.AddItem "商品17"
Case "氏名3"
.AddItem "商品22"
.AddItem "商品23"
.AddItem "商品24"
.AddItem "商品25"
.AddItem "商品26"
Case "氏名4"
.AddItem "商品33"
.AddItem "商品34"
.AddItem "商品35"
.AddItem "商品36"
.AddItem "商品37"
.AddItem "商品38"
.AddItem "商品39"
.AddItem "商品40"
End Select
.ListIndex = 0
End With
End Sub

Comments

[meg_]

ブックのパスは固定なのですか？

[o-k]

meg_さんありがとうございます。

はい、パスは固定で大丈夫です

[meg_]

とりあえずユーザーが指定したブックを開き、ユーザーが指定したシートを開くコードを書きましょう。

[o-k]

すみません、そこもできておりません。
そのため一旦はOpenFileNameでユーザーにファイルを開いてもらおうとしました。
しかし、やはり2つのコンボボックス か2つのリストボックスでブックとシートを選んで開きたいと思い、調べておりました。
シートのコピーの前にそこでつまづいてしまっております。

[meg_]

VBAでExcelブックを開く方法は調べればすぐ分かりますよ。（フォルダパスとファイル名は既に決まっているので調べてコードを書きましょう！）

[退会済みユーザー]

別ファイルから値を取得するサンプルをご提示します。
これを検証してから本題に入ったほうがいいかもしれません・・。
内容は、別ファイルを開いてA１セルの値を自分のエクセル・シート名dataのA１セルに
貼り付けて閉じるというものです。

sub test

Dim file As String
Dim wb1 As Workbook
Dim sh1 As Worksheet

'test.xlsxはこのエクセルファイルと同じフォルダ内におく
'test.xlsxのテストシートのA1セルを呼び出し元のdataシートのA１セルにコピーする
'処理が終わったらtest.xlsxを閉じる

book="test.xlsx"
sheetname="テスト"

file = ThisWorkbook.Path & "\" & book

'■bookを開く

Set wb1 = Workbooks.Open(file)
Set sh1 = workseeh(sheetname)

'■処理記述

//ここに処理を記述

msgbox"処理実行!!"

ThisWorkbook.Sheets("data").range("A1").value = wb1.sh1.range("A1").value

'■開いたbookを閉じる

wb1.Close savechanges:=Flase '(True)

Set wb1 = Nothing '変数初期化
Set sh1 = Nothing'変数初期化

end sub

[o-k]

meg_さんありがとうございます。
もう一度チャレンジしてみます。

ymakotoさんありがとうございます。
後ほどファイルとシートを作ってやってみます。

Answer 1

一つ目のリストボックスでブックを選び、
二つ目のリストボックスでシートを選びます。
選んだシートの内容全てをコピーして
「結果.xlsm」の「データ」シートに貼り付けたいと思っています。

セルの内容をコピーしたいと思った時、前提条件として

1）セル範囲の特定をする必要があります。
2）セルはシート上にありますので、どのシートに属するのかを特定する必要があります
3）そのシートは、ブックの中に存在しますので、どのブックのシートかを特定する必要があります。
4）セルをコピーするためにはブックを開いている必要があります。
5）ブックを開くにはそのファイルのフルパスを指定する必要があります。

ということは、
情報として保持しておきたいものは(表示は必要最低限でよい）、
1）ブック名(ファイルのベースネームでもよい）＆シート名
2）ファイルのフルパス
3）シート名
4）セル範囲（全てなので、UsedRangeプロパティで得られるセル範囲でよい？）

の、リストをまずは取得する必要があるでしょう。

そうすると、プログラムの流れとしては、

1）開きたいファイルはどのフォルダーにあるかを指定する
2）そのフォルダーの中のファイルのフルパスをリストにする（変数の中またはシート上に）
3）一覧から順次ファイルを開く
4）開いたファイル（＝ブック）の中のシート名をリストにする
5）開いたファイルを閉じる
6）3に戻る
7）取得したリストをリストボックスに入れる

というような流れになるかと（漏れがあるかも？）思います。
これらを一つづ解決していく必要があります。

---

そして、出来たリストボックスを選択することで、
1）フルパスとシート名などをを取得し、
2）指定のファイルを開く
3）指定のシートのセルをコピーする
4）ファイルを閉じる
（複数のブックにまたがる場合は、上記を繰り返す。）

というプログラムを起動したらいいと思います。

いずれもまだ出来てないという事なら、
マクロのあるブックと同じフォルダーから、
Excelファイルのフルパスの一覧をシート上に作ってみるところから始めるといいと思います。

その後は文字列の加工等いろいろなことを覚えてください。
シート上に一覧ができたら、それをリストボックスに転記してみてください。
（シート上にリストを作らなくてもいいけど、そうなると配列変数とかも勉強する必要が出てきます）

---

追記

Excelファイルの一覧を作ることはできたのですが、
その後が全くできません。
せっかく詳しく教えていただいたのですが、
これ以上できる気がしません。
申し訳ありません。

一朝一夕で出来るものではありません。
気長に根気強く勉強していくしか道はありません。
やりたいことと並行して、基礎をある程度やっておかないと、
メンテナンスまではこちらは面倒見きれません。
1つのプログラミング言語を覚えるのに、
最低200時間はかかると言われているようです。

以下をユーザーフォームのモジュールに書きます。

Option Explicit

Private Sub UserForm_Initialize()
    Set一覧取得
    With Me.ListBox1
        .List = ThisWorkbook.Worksheets(1).Range("B1").CurrentRegion.Value
        .ColumnWidths = "100;0;0;0"
    End With
End Sub

Sub Set一覧取得()
    With ThisWorkbook.Worksheets(1).Cells(1)
        'シートの初期化
        .CurrentRegion.ClearContents

        'ファイルのフルパス一覧の取得
        Setファイルのプルパス一覧 .Cells

        'シート名の一覧取得
        Setシートの一覧 .CurrentRegion

        '作業列のクリア
        .EntireColumn.ClearContents
    End With
End Sub

Sub Setファイルのプルパス一覧(ByRef c As Range)
    Const csPath As String = "C:\Users\Public\test\"
    Dim ixRow As Long
    Dim buf As String

    buf = Dir(csPath & "*.xlsx")
    Do Until Len(buf) = 0
        ixRow = ixRow + 1
        c(ixRow, "A").Value = csPath & buf
        buf = Dir()
    Loop
End Sub

Sub Setシートの一覧(ByRef rng As Range)
    Dim c As Range
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim ixRow As Long

    For Each c In rng
        Set wbk = Workbooks.Open(c.Value)
        For Each wsh In wbk.Worksheets
            ixRow = ixRow + 1
            With rng(ixRow, "B")
                .Offset(, 1).Value = wbk.FullName
                .Offset(, 2).Value = wsh.Name
                .Offset(, 3).Value = wsh.UsedRange.Address(False, False, xlA1, True)
                .Value = Get表示名(.Offset(, 3).Value)
            End With
        Next
        wbk.Close False
    Next
End Sub

Function Get表示名(ByVal sName As String) As String
    Dim i As Long
    
    i = InStr(sName, "'")
    If i > 0 Then
        Get表示名 = Left(sName, i - 1)
    End If
End Function

動きを目視で確認しやすいように、逐一シート上に展開してます。
実行して「出来た！」で終わらず、
ヘルプなりWebなりで調べて一行一行を理解されることを望みます。
↓を参考にしてステップ実行をしながら、シート上の結果と、
コードを見比べてみてください。
プロパティ、メソッドの探り方 マクロ記録とＦ１のHelpを使う

その他参考サイト
Excel(エクセル)VBA入門：目次
「VBA基本」のメニュー
Excel VBAコンテンツ
エクセルマクロ・Excel VBAの使い方
初めてのVBAマクロ "Hello World!"

この辺で一通り網羅していると思いますが、
ExcelVBAの情報は多数ありますので検索してみて、
上手くいかなければ、別途質問してください。

＞＞Setファイルのプルパス一覧
プルパスってなんだ＾＾；
誤字です。
愛嬌ということで訂正しません＾＾；；
誰かに見られて恥ずかしければそちらで直してください。

Comments

[退会済みユーザー]

すばらしい・・。

[mattuwan]

ymakotoさん、サンプルコードはご自分の回答に追記してください。

[退会済みユーザー]

すみません。扱いになれず。初心者なので勉強になりました・・。

[mattuwan]

大丈夫です。
ぼくもここのルールをあんまり分かってないですから。
積極的に勉強した、あるいは考察した結果を共有しようとするのは悪くないと思います＾＾
コーディングでは上級者にかなわないかもしれませんが、
ロジックはそれぞれの知識と経験で上級者でも思いつかないことを提示できると思いますので、
お互いに頑張りましょう＾＾

[退会済みユーザー]

ありがとうございます。
また、貼り付けたらみのがしてください。

[o-k]

mattuwanさんありがとうございます。
細かいご指導恐縮です。
じっくり取り組まなければならなそうですので、少し時間がかかりそうです。

ymakotoさんありがとうございます。
度々のアドバイス本当に助かります。

[mattuwan]

かなり時間が掛かると思いますよ。
じっくり頑張ってみてください。
参考URL>>
http://officetanaka.net/excel/vba/file/file07.htm

[o-k]

mattuwanさんありがとうございます。
チャレンジしてみてはいるものの・・・。
まだ私には早かったかもしれません。

ymakotoさんのコードの実行からうまくいっておりません。

[o-k]

Excelファイルの一覧を作ることはできたのですが、
その後が全くできません。
せっかく詳しく教えていただいたのですが、
これ以上できる気がしません。
申し訳ありません。

[o-k]

mattuwanさんありがとうございます。
こんなに複雑なものだったのですね。
昨夜は一旦諦めモードでしたが、もう一度チャレンジしてみたいと思います。
とても丁寧なご回答ありがとうございました。

[mattuwan]

リアルでも、電話先の相手にでも作業できるように事細かに
作業手順を説明しないと、ちゃんと仕事をいてもらえるかわからないですよね？
パソコンに仕事をしてもらうのも同じことです。

逆に1回、誰がやっても同じ結果が得られる作業手順書（≒プログラム）が出来れば、あとは、「この作業をお願い」とワンクリックでパソコンに任せるだけです。

[o-k]

ありがとうございます。
今シートを作って勉強中です。
せっかく教えていただいたので、何とか形にしたいと思います。

[mattuwan]

頑張ってください。
躓いたら新規で質問してください。
いつ対応できるか解らないので。
その時には、ここのリンクも貼って、
ここで習ったことを勉強中ということも説明すると、
話しの流れが伝わりやすいと思います。

[o-k]

ありがとうございます！

Answer 2

まだ違うかもしれません。取り急ぎサンプルです。

メインのシートのユーザーフォームにボタンを配置します。
続いて、モジュールに下記を貼り付けます。

リストボックス1とリストボックス2からそれぞれ、BOOK名とsheet名を取得します。

そして転記関数を呼び出します。呼び出すBookは同一フォルダ内にあるものとします。

指定したブックを開いて、（処理を行い）閉じます。

処理ないようはご自身でお願いします。

Sub 転記(book As String, sheetname As String)

Dim file As String
Dim wb1 As Workbook
Dim sh1 As Worksheet

file = ThisWorkbook.Path & "\" & book

'■bookを開く
 
Set wb1 = Workbooks.Open(file)
Set sh1 = workseeh(sheetname)


'■処理記述

msgbox "何か処理したよ！！"


'（例）データを転記する--ここはご自身で記述します。
//With ThisWorkbook.Sheets("data")
//    .Range("A2").value = wb1.sh1.Range("A2").value
//    .Range("B2").value = wb1.sh1.Range("A2").value
//
//End With

'■開いたbookを閉じる

wb1.Close savechanges:=Flase '(True)

Set wb1 = Nothing
Set sh1 = Nothing

End Sub


Private Sub CommandButton1_Click()
Dim book As String

Dim sheet As String

book = ListBox1.value & ".xlsx"
sheet = ListBox2.value

Call 転記(book, sheet)


コード

Comments

[退会済みユーザー]

追加）
動的にメニューを管理する例）－－配列を使わない場合
masterシートのA列に商品名があるとして、自動でセットします。

Private Sub UserForm_Initialize()
Dim cnt As Long
Dim 商品 As String

'最終行を数える
cnt = Sheets("master").Cells(Rows.Count, 1).End(xlUp).Row

With ListBox1

For i = 1 To cnt
商品 = Sheets("master").Range("A" & i).value

.AddItem 商品

Next

End With

End Sub

きれいに記述されているサンプルがWEB上にあると思いますので
取り急ぎ。。。

[o-k]

ymakotoさんありがとうございます。
何度もすみません。
今2番目にいただいたコードで色々試している最中です。
3番目のもこのあと参考にさせていただきます！

[退会済みユーザー]

内容が違ったら直しますね。