Excel-Makro, um bestimmte Texte in Zeile 1 aus einem Blatt zu suchen, kopieren Sie die Spalte unter dem Text, und fügen Sie auf ein anderes Blatt

Question

Ich bin ziemlich neu in Excel Macro und brauche etwas Hilfe, um die folgende Aufgabe zu erfüllen.

Ich habe zwei Blätter in der gleichen Arbeitsmappe; Eines ist das Hauptblatt, das bearbeitet werden kann, und das andere ist, bestimmte Spalten aus dem Hauptblatt zu extrahieren. Da im Hauptblatt Spalten eingefügt oder gelöscht werden können, besteht mein Ansatz darin, bestimmte Titel einzugeben, die ich in Blatt 2 (ursprüngliches leeres Blatt) extrahieren würde, diese Texte/Spaltentitel in Blatt 1 (Hauptblatt) nachzuschlagen/anzupassen; Kopieren Sie dann die gesamte Spalte unter dem Titel der Übereinstimmungsspalte und fügen Sie sie in Blatt 2 ein.

Ich habe den folgenden Code, aber immer noch tauchen Fehler auf. Da ich mit der Macro-Syntax nicht vertraut bin, bin ich mir nicht sicher, ob dieser Ansatz anwendbar ist. Ich schätze jede Hilfe, Kommentar oder Vorschlag. Danke im Voraus.

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

Sie besser Find() Methode der Range Objekt verwenden würde Werte in einem Bereich

so können Sie diesen Code

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