[[20201021163042]]　『VBAでブックとシートを手動選択したい』（Fラン卒）　ページの最後に飛ぶ

『VBAでブックとシートを手動選択したい』（Fラン卒）

実行すると「ファイルを開く」画面が立ち上がり、ここで選んだExcelブックの「○○」という名前のシートからデータを転記するマクロがあります。

Sub tenki()

Dim WorkData As String
'

    WorkData = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
'
    If WorkData = "False" Then
        End
    End If
    On Error GoTo 0
    Workbooks.Open WorkData, False, True
    On Error GoTo 0

Application.ScreenUpdating = False

    WorkData = WorksheetFunction.VLookup("データ", [〇〇!A1:AI256], 22, 0)
    ThisWorkbook.ActiveSheet.[C1] = StrConv(WorkData, vbNarrow)

''A列に「データ」と書いてある行の、V(22)列からコピー、半角に変換して本ブックC1セルに貼る

     WorkData = WorksheetFunction.VLookup("サイズ", [〇〇!A1:AI256], 17, 0)
    ThisWorkbook.ActiveSheet.[C4] = StrConv(WorkData, vbNarrow)
''A列に「サイズ」と書いてある行の、Q(17)列からコピー、半角に変換して本ブックC4セルに貼る

        WorkData = WorksheetFunction.VLookup("商品コード", [〇〇!A1:AI256], 12, 0)
    ThisWorkbook.ActiveSheet.[S19] = WorkData
''A列に「商品コード」と書いてある行の、L(12)列からコピー、本ブックS19セルに貼る
        WorkData = WorksheetFunction.VLookup("倉庫番号", [〇〇!A1:AI256], 24, 0)
    ThisWorkbook.ActiveSheet.[S21] = WorkData
''A列に「倉庫番号」と書いてある行の、X(24)列からコピー、本ブックS21セルに貼る

(以下、同様のコピー→貼り付けを行うコード多数)

         WorkData = WorksheetFunction.VLookup("価格", [〇〇!A1:AI256], 31, 0)
    ThisWorkbook.ActiveSheet.[S42] = StrConv(WorkData, vbNarrow)
''A列に「価格」と書いてある行の、AE(31)列からコピー、半角に変換して本ブックS42セルに貼る

    ActiveWorkbook.Close False

  Application.ScreenUpdating = True
  MsgBox ("完了")

End Sub

この機能を保ったまま、
マクロ起動→「ファイルを開く」でExcelのブックを手動選択する
→手動選択したExcelのブックから、読み取り先のシートを手動で選択する
→選択したシートの名前を「〇〇」に代入する
→データ転記実行
となるように改良したいです。
(読み取り先のシート名は不定であり、また何列目にあるかも不定です)

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

 InputBoxメソッド（関数じゃないほう）を使ってはどうですか？

     Dim rng As Range

     Set rng = Application.InputBox("目指すシートのどこかのセルを選択して下さい", Type:=8)
     Set rng = rng.Parent.Range("A1:AI256")

     'そのrngをこんな風に使えます。
     Debug.Print WorksheetFunction.VLookup("データ", rng, 22, 0)

（γ） 2020/10/21(水) 17:48

ありがとうございます。　ここに書いたような箇所は問題なくできました。

ただ、以下のようなコードが含まれていたことを忘れておりました。

    WorkData = Worksheets("〇〇").Range("S6").Value
    ThisWorkbook.ActiveSheet.[D1] = WorkData

''VLOOKUPではなく、固定のセルから読み込んで貼りつける

    Dim alp As Long
    alp = 7
    For i = 1 To 26
        WorkData = Worksheets("〇〇").Cells(alp, 19).Value
        If Len(WorkData) <> 1 Then
            Exit For
        End If
        If WorkData = " " Then
            Exit For
        End If
        If WorkData = "　" Then
        Exit For
        End If
        ThisWorkbook.ActiveSheet.[D1] = WorkData
        alp = alp + 1
    Next i

''コピーして、本ブックD1セルに上書きする　S7、S8、S9…とループを組む(内容が1文字でない/空白1文字であれば、貼る前にループが終了する)
''念のため、26回でループが終わる(中身はA,B,…と続く想定)

このような場合、「rng」(Range型)を〇〇の箇所に入れると「型が一致しません」となります。
「rng」からシート名だけを抽出する方法を教えていただければ幸いです。
（Fラン卒） 2020/10/22(木) 11:13

自己解決しました。ありがとうございます。

    Dim rng As Range
    Dim sht As Worksheet
     Set rng = Application.InputBox("読み込むシートのどこかのセルを選択して下さい", Type:=8)

     Set rng = rng.Parent.Range("A1:AI256")
      Set sht = rng.Parent

  WorkData = sht.Range("S6").Value
    ThisWorkbook.ActiveSheet.[D1] = WorkData

  Dim alp As Long
    alp = 7
    For i = 1 To 26
        WorkData = sht.Cells(alp, 19).Value
        If Len(WorkData) <> 1 Then
            Exit For
        End If
        If WorkData = " " Then
            Exit For
        End If
        If WorkData = "　" Then
        Exit For
        End If
        ThisWorkbook.ActiveSheet.[D1] = WorkData
        alp = alp + 1
    Next i

このように変えて解決しました。
（Fラン卒） 2020/10/22(木) 11:34

コメント返信：

[ 一覧(最新更新順) ]

[[20201021163042]] 『VBAでブックとシートを手動選択したい』（Fラン卒） ページの最後に飛ぶ

[[20201021163042]]　『VBAでブックとシートを手動選択したい』（Fラン卒）　ページの最後に飛ぶ