Excelマクロ1行目の特定のテキストを1つのシートから検索し、テキストの下の列をコピーして別のシートに貼り付けます。

Question

Excelマクロは新しく、次のタスクを達成するためにいくつかの助けが必要です。

同じブックに2枚のシートがあります。 1つは編集可能なメインシートで、もう1つはメインシートから特定の列を抽出することです。メインシートには列が挿入または削除されている可能性があるため、私はシート2（最初は空白シート）に抽出する特定のタイトルを入力し、シート1（メインシート）のテキスト/列タイトルをルックアップ/マッチングします。その列のタイトルの下に列全体をコピーし、シート2に貼り付けます。

私は次のコードを持っていますが、まだエラーはポップアップしています。私はマクロ構文にはあまり慣れていないので、このアプローチが適用可能かどうかはわかりません。私は、何か助け、コメント、提案を感謝します。前もって感謝します。

Private Sub CommandButton1_Click() 

Dim i As Long 
Dim j As Long 
Dim r As Long 

For i = 1 To 30 
    For j = 1 to 30 
     If Sheets(2).Cells(1, j).Value = Sheets(7).Cells(1, i).Value Then 
      For r = 2 To 1000 
       Sheets(2).Cells(r, j).Copy 
       Sheets(7).Cells(r, i).PasteSpecial Paste:=xlPasteFormats 
       Sheets(7).Cells(r, i).PasteSpecial Paste:=xlPasteValue 
      Next r 
     End If 
    Next j 
Next i 

End Sub 

Answer 1

方が良いので、あなたは、このコード

Option Explicit 

Private Sub CommandButton1_Click() 
    Dim f As Range, mainShtHeaderRng As Range, blankShtHeaderRng As Range, cell As Range 
    Dim mainSht As Worksheet, blankSht As Worksheet 

    Set mainSht = Worksheets("mainSht") '<--| set your "main" sheet 
    Set blankSht = Worksheets("blankSht") '<--| set your "blank" sheet 

    Set mainShtHeaderRng = mainSht.Rows(1).SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues) '<--| set your header range in the "main" sheet 
    Set blankShtHeaderRng = blankSht.Rows(1).SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues) '<--| set your header range in the "blank" sheet 
    For Each cell In blankShtHeaderRng '<--| loop through "blank" sheet headers... 
     Set f = mainShtHeaderRng.Find(what:=cell.Value, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<--|... and search them between the "main" sheet headers 
     If Not f Is Nothing Then '<--| if found... 
      Range(f, mainSht.Cells(mainSht.Rows.Count, f.Column).End(xlUp)).Copy '<--| copy "main" sheet corresponding column doqwn to its last non empty cell... 
      cell.PasteSpecial Paste:=xlPasteFormats '<--| ... and paste formats... 
      cell.PasteSpecial Paste:=xlPasteValues '<--| ... and values to "blank" sheet current header column 
     End If 
    Next cell 
End Sub