関数は自分で作る

エクセルでマクロを作って汎用的にするには工夫が必要です。

私は、「入力」とか「main」とかのワークシートを追加します。このワークシートはワークシートの一番左に置きます。また、「管理用」とか「管理」、「補助」、「補助シート」、「Library」などマクロで使うリストや管理用のデータを置くワークシートを一番右に置きます。「管理」用のワークシートは、入力や見る必要が無いので普段は非表示にしていてもいいでしょう。

前回の例を少し汎用的にします。入力用のセルは黄色にしてます。

ActiveXの方のコマンドボタン、リストボックスを使いました。コード内にExcelの名前を使っています。

名前のデータは、Range(名前)で値を取り出せるが、他のワークブックではできない。

ワークブックオブジェクト.Names(名前).RefersToRange

で他のワークブックの名前の値を取り出せる。

標準モジュールのコード。このコードはそのままカトペでOK

Option Explicit
Dim pwb As Workbook, cwb As Workbook

Sub main()
    myChdir
    getXlsFile
    myCopy
End Sub

Sub myChdir()
    ’VBA.ChDir VBA.Replace(VBA.CurDir, "Documents", "Downloads")
　　VBA.ChDir VBA.Environ("USERPROFILE") & "\downloads"
　　Sheet4.Range("c1") = VBA.CurDir
End Sub

Sub getXlsFile()
    myChdir
    Dim x
    x = VBA.Dir(Range("ワイルドカード"))
    Sheet4.ListBox1.Clear
    Do Until "" = x
        Sheet4.ListBox1.AddItem x
        x = Dir
    Loop
    If 0 = Sheet4.ListBox1.ListCount Then
        Sheet4.ListBox1.AddItem "ダウンロードフォルダ"
        Sheet4.ListBox1.AddItem "に"
        Sheet4.ListBox1.AddItem Range("ワイルドカード")
        Sheet4.ListBox1.AddItem "で検索できるファイルが"
        Sheet4.ListBox1.AddItem "ありますか？"
    End If
End Sub

Sub myCopy()
    myChdir
    Set cwb = Excel.Workbooks.Add(Range("読み込みファイル"))
    Set pwb = ThisWorkbook
    
    Dim s As String
    s = pwb.Names("コピー元ワークシート").RefersToRange
    cwb.Worksheets(s).Select
    s = pwb.Names("コピー元検索列").RefersToRange
    Excel.Range(s & "1").Select
    Do Until Excel.ActiveCell = pwb.Names("コピー元検索文字列").RefersToRange
        Excel.ActiveCell.Offset(1, 0).Select
    Loop

    Excel.Range(Excel.ActiveCell.Offset(0, 1), Excel.ActiveCell.Offset(0, 7)).Select
    Selection.Copy
    pwb.Activate
    s = Range("入力ワークシート")
    Sheets(s).Select
    s = Range("コピー先検索列") & "1"
    Excel.Range(s).Select
    Do Until Range("コピー先検索文字列") = Excel.ActiveCell
        Excel.ActiveCell.Offset(1, 0).Select
    Loop
    Excel.ActiveCell.Offset(0, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    cwb.Close
End Sub

Sheet4のコード。CommandButton1_Click()のような＿アンダーバーの入るプロシージャはイベントです。ですからその文字列は書きません。プロシージャ／イベント　ボックスで選択して入れます。Sheet4のコードは全部イベントプロシージャです。プロシージャボックスはイベントボックスでもあります。

Option Explicit

Private Sub CommandButton1_Click()
    getXlsFile
    Worksheet_Activate
End Sub

Private Sub CommandButton2_Click()
    myCopy
End Sub

Private Sub ListBox1_Click()
    Range("読み込みファイル") = Me.ListBox1.Text
End Sub

Private Sub ListBox2_Click()
    Range("入力ワークシート") = Me.ListBox2.Text
End Sub

Private Sub Worksheet_Activate()
    Me.CommandButton1.Caption = "読み込みファイル一覧"
    Me.ListBox1.BackColor = VBA.vbYellow
    Me.CommandButton2.Caption = "実行"
    Me.ListBox2.BackColor = VBA.vbYellow
    Dim sh As Worksheet
    Me.ListBox2.Clear
    For Each sh In ThisWorkbook.Worksheets
        Me.ListBox2.AddItem sh.Name
    Next
End Sub

Rage(“B1:C2”).Select のような複数のセルをActiveCellで指定する方法には

ActiveCellがA1とした場合

Excel.Range(Excel.ActiveCell.Offset(0, 1), Excel.ActiveCell.Offset(1, 2)).Select

Rangeオブジェクトって深いわ。

「,」カンマで範囲が指定できるんね。やってみるもんだ。複数も範囲を複数指定もできるしね。

また、

Excel.RangeもあるけどWorkSheet.Rangeもある。

ActiveCellは、Excel.ActiveCell（Excel.Application.ActiveCell）しか無い。

以下は、完成したコード

Option Explicit
Dim pwb As Workbook, cwb As Workbook

Sub main()
    myChdir
    getXlsFile
    myCopy
End Sub

Sub myChdir()
    VBA.ChDir VBA.Replace(VBA.CurDir, "Documents", "Downloads")
End Sub

Sub getXlsFile()
    Dim x
    x = VBA.Dir("*_hitetu_kmc.xls")
    Do Until VBA.Now - VBA.FileDateTime(x) < 1 / 24
        x = Dir
    Loop
    Excel.Workbooks.Add x
    Set cwb = Excel.Workbooks(2)
    Set pwb = Excel.Workbooks(1)
End Sub

Sub myCopy()
    cwb.Worksheets("伸銅・アルミ圧延").Select
    Excel.Range("A1").Select
    Do Until Excel.ActiveCell = "はく"
        Excel.ActiveCell.Offset(1, 0).Select
    Loop
    cwb.Activate
    Excel.Range(Excel.ActiveCell.Offset(0, 1), Excel.ActiveCell.Offset(0, 7)).Select
    Selection.Copy
    pwb.Activate
    Sheets("Sheet1").Select
    Excel.Range("b1").Select
    Do Until "" = Excel.ActiveCell
        Excel.ActiveCell.Offset(1, 0).Select
    Loop
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    cwb.Close
End Sub