エクセルのマクロで文字列から特定の文字列のみ抽出したい

エクセルのSheet1にユーザの情報が入っています

ここからNewSheetに保険者番号と保険証番号のみ抽出したいと考えています

下記のサイトを参考にしました。
しかし出力うまくしません、考えられることご教授いただきたいです。
よろしくお願いいたします。
参考サイトURL

Option Explicit
 
Sub GetColumnsWithKeywords()
    Dim keywords As String
    keywords = InputBox(" 保険者番号,保険証番号") 
    If keywords = "" Then: Exit Sub

    Dim ws1 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Dim ws2 As Worksheet
    Set ws2 = Worksheets.Add(after:=ws1)
    ws2.Name = "NewSheet"
    Dim k As Long
    k = 1
    Dim cmax As Long
    cmax = ws1.UsedRange.Rows.Count
    Dim rng As Range
    Dim keyword As Variant
    Dim i As Long
    For i = 1 To ws1.UsedRange.Columns.Count
        Set rng = ws1.Range("A1:A" & cmax).Offset(0, i - 1)
        Debug.Print rng.Address
        For Each keyword In Split(keywords, ",")
            If Not rng.Find(keyword) Is Nothing Then
                ws1.Columns(i).Copy (ws2.Columns(k))
                k = k + 1
                Exit For
            End If
        Next
              
    Next
End Sub

meg_

2021/12/07 11:16

> しかし出力うまくしませんどういう出力になったのでしょうか？

hatena19

2021/12/07 11:35

InputBoxで入力を要求されますが、何を入力したのでしょうか。その結果、どういう出力になったのでしょうか。希望の結果は何だったのでしょうか。

MISIAN-MISIAN

2021/12/08 08:44 編集

InputBoxで入力を求められて保険者番号,保険証番号と入力しました。しかし、NewSheetが作られてその中身は保険証番号の列のみ抽出されてました。保険者番号の列が表示されない状況です。ご教授お願いいたします

行動規範の内容に同意します

回答1件

ベストアンサー

NewSheetに保険者番号と保険証番号のみ抽出したいと考えています

NewSheetに保険者番号の列と保険証番号の列を出力したいのなら、

vba
1Private Sub Sample()
2    Dim keywords As String
3    keywords = "保険者番号,保険証番号"
4
5    Dim ws1 As Worksheet
6    Set ws1 = Worksheets("Sheet8")
7    Dim ws2 As Worksheet
8    Set ws2 = Worksheets.Add(after:=ws1)
9    ws2.Name = "NewSheet"
10
11    With ws1.Range("A1").CurrentRegion
12        Dim i As Variant, k As Long, keyword
13        k = 1
14        For Each keyword In Split(keywords, ",")
15            i = WorksheetFunction.Match(keyword, .Rows(1), 0)
16            If Not IsError(i) Then
17                .Columns(i).Copy ws2.Columns(k)
18                k = k + 1
19            End If
20        Next
21    End With
22End Sub