Wie kopiere/füge ich bestimmte Zellen aus anderen Arbeitsblättern in das aktuelle Arbeitsblatt ein?

Question

Ich benutze diesen Code, um einen Benutzernamen für die Suche nach allen zugehörigen Informationen aus mehreren Transaktionen zu verwenden. Es sollte sie dann in das aktuelle Arbeitsblatt einfügen. Es scheint zu laufen, da es keine Fehler hervorruft und den letzten "Select" -Befehl ausführt, aber keine eingefügten Daten zurückgibt.

Option Explicit 
Sub InvestorReport() 

Dim investorname As String 
Dim finalrow As Integer 
Dim i As Integer 'row counter 

Sheets("Sheet1").Range("D6:K50").ClearContents 

investorname = Sheets("Sheet1").Range("B3").Value 
finalrow = Sheets("Investments").Range("I1000").End(xlUp).Row 


For i = 2 To finalrow 
    If Sheets("Investments").Cells(i, 1) = investorname Then 
     MsgBox ("Works") 
     Range(Cells(i, 2), Cells(i, 12)).Copy 
     Sheets("Sheet1").Range("D100").End(xlUp).Offset(1, 0).PasteSpecial 
     End If 
Next i 


Range("B3").Select 

End Sub 

Answer 1

Dies ist der Code richtig Blätter verweisen:

Option Explicit 

Sub InvestorReport() 
    Dim investorname As String 
    Dim finalrow As Long 
    Dim i As Long 'row counter 

    With Sheets("Sheet001") '<--| refer to "Sheet1" sheet 
     .Range("D6:K50").ClearContents '<--| with every initial "dot" you keep referencing the object after the "With" keyword ("Sheet1" sheet, in this case) 
     investorname = .Range("B3").value 
    End With 

    With Sheets("Investments") '<--| refer to "Investments" sheet 
     finalrow = .Cells(.Rows.Count, "I").End(xlUp).row '<--| .Cells and .Rows refer to "Investments" sheet 
     For i = 2 To finalrow 
      If .Cells(i, 1) = investorname Then 
       .Range(.Cells(i, 2), .Cells(i, 12)).Copy '<--| .Range and .Cells refer to "Investments" sheet 
       Sheets("Sheet001").Range("D100").End(xlUp).Offset(1, 0).PasteSpecial '<--| here all references are explicitly made to "Sheet1" sheet 
      End If 
     Next i 
    End With 

    Sheets("Sheet001").Range("B3").Select 
End Sub 

und hier folgt der Code Schleifen zu vermeiden und die Nutzung Autofilter:

Sub InvestorReport2() 
    Dim investorname As String 
    Dim finalrow As Long 
    Dim i As Long 'row counter 

    With Sheets("Sheet001") '<--| refer to "Sheet1" sheet 
     .Range("D6:K50").ClearContents '<--| with every initial "dot" you keep referencing the object after the "With" keyword ("Sheet1" sheet, in this case) 
     investorname = .Range("B3").value 
    End With 

    With Sheets("Investments") '<--| refer to "Investments" sheet 
     With .Range("A1", .Cells(.Rows.Count, "L").End(xlUp)) '<--| refer to "Investments" sheet columns A to I fom row 1 (header) down to last non empty one in column I 
      .AutoFilter field:=1, Criteria1:=investorname '<--| filter data on first column values matching "investorname" 
      If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell has been filtered... 
       .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).SpecialCells(xlCellTypeVisible).Copy '<--| ... copy filtered cells skipping headers and first column... 
       Sheets("Sheet001").Range("D100").End(xlUp).Offset(1, 0).PasteSpecial '<--| ...and paste them 
      End If 
     End With 
     .AutoFilterMode = False '<--| .. show all rows back... 
    End With 

    Sheets("Sheet001").Range("B3").Select 
End Sub