Копирование содержимого с одного листа на другой в соответствии с основным списком ссылок VBA

Question

Я пытаюсь отформатировать отчет и скопировать важные значения на чистый лист.

Я использую основной список ссылок, чтобы решить, какая информация важна или нет. Уникальные ссылки для каждого элемента хранятся на листе, названном «Главный список» в столбце B, я хочу, чтобы мой макрос просматривал этот список и видел, может ли он найти совпадение в листе «Сырые данные» и скопировать его, сопоставляя строку «Отчет».

Попытка, которую я сделал, делает все начальное форматирование прекрасным, но затем спотыкается, когда она попадает в первую команду While. Я пробовал несколько разных способов сделать это, и я не могу заставить его работать. По словам принцессы Леи, помогите мне перетекать стека, у вас есть единственная надежда

Dim RD As Worksheet, Report As Worksheet, Masterlist As Worksheet 
Dim LSearchRow As Integer 
Dim LCopytoRow As Integer 
Dim rngFound As Range 
Dim SearchItem As String 


Set RD = Sheets("Raw Data") 
Set Report = Sheets("Report") 
Set Masterlist = Sheets("Master List") 


LCopytoRow = 1 
LSearchRow = 1 

RD.Select 
    Columns("A:A").Select 
    Selection.Delete Shift:=xlToLeft 

    Columns("B:D").Select 
    Selection.Delete Shift:=xlToLeft 

    Columns("D:Q").Select 
    Selection.Delete Shift:=xlToLeft 

    Columns("E:I").Select 
    Selection.Delete Shift:=xlToLeft 

    Columns("C:C").Select 
    Selection.ClearContents 


While Len(Range("A" * CStr(LSearchRow)).Value) > 0 
    SearchItem = Masterlist.Range("B" & k).End(xlUp).Row 
    If Range("A" & CStr(LSearchRow)).Value = Masterlist.Range("B" & CStr(LSearchRow)).Value Then 
     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select 
     Selection.Cut 

     Report.Select 
     Rows(CStr(LCopytoRow) & ":" & CStr(LCopytoRow)).Select 
     ActiveSheet.Paste 

     LCopytoRow = LCopytoRow + 1 

     RD.Select 
    End If 

    LSearchRow = LSearchRow + 1 

Wend 

Заранее благодарен!

Answer 1

Трудно проверить без выборки данных, но что-то, как это должно работать для вас:

Sub tgr() 

    Dim wb As Workbook 
    Dim wsMstr As Worksheet 
    Dim wsData As Worksheet 
    Dim wsRprt As Worksheet 
    Dim aMasterFilter As Variant 

    Set wb = ActiveWorkbook 
    Set wsMstr = wb.Sheets("Master List") 
    Set wsData = wb.Sheets("Raw Data") 
    Set wsRprt = wb.Sheets("Report") 

    wsData.Range("A:A,C:E,H:U,W:AA").EntireColumn.Delete xlToLeft 
    wsData.Columns("C").EntireColumn.ClearContents 
    wsData.AutoFilterMode = False 

    aMasterFilter = Application.Transpose(wsMstr.Range("B1", wsMstr.Cells(wsMstr.Rows.Count, "B").End(xlUp)).Value) 
    With wsData.Range("A1", wsData.Cells(wsData.Rows.Count, "A").End(xlUp)) 
     .AutoFilter 1, aMasterFilter, xlFilterValues 
     .EntireRow.Copy wsRprt.Range("A1") 
     .EntireRow.Delete xlShiftUp 
     .Parent.AutoFilterMode = False 
    End With 

End Sub