将来自不同工作表的特定列的行内容真实复制到特定工作表中

Question

我需要将工作簿上不同工作表中的3个特定列的行内容复制到特定工作表中的特定范围。例如在Sheet1中我有一个从B1到E40的范围我想复制从列B到D中的内容，在列E中显示“TRUE”，然后将其粘贴到名为“Analysis”的Worksheet中。

我希望宏进入工作表2，工作表3和工作表4并执行相同的操作（在E列中查找TRUE，并将符合该条件的行B到D复制）并将值粘贴到另一个下方在工作表“分析”中。

我很新的VBA，我发现了一个代码，我认为这将有助于开始，但我需要帮助。你能给我一个主意吗？我附上了我发现的代码，以便你可以给我你的意见，它可能不是所需要的，但在列表中它可能是一个基础。非常感谢。

Sub MyCode() 

Dim LSearchRow As Integer 
Dim LCopyToRow As Integer 

On Error GoTo Err_Execute 

'Start search in row 3 
LSearchRow = 3 

'Start copying data to row 2 in Sheet2 (row counter variable) 
LCopyToRow = 2 

While Len(Range("A" & CStr(LSearchRow)).Value) > 0 

'If value in column BA = "Soccer", copy entire row to Sheet2 
If Range("BA" & CStr(LSearchRow)).Value = "Soccer" Then 

    'Select row in Sheet1 to copy 
    Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select 
    Selection.Copy 

    'Paste row into Sheet2 in next row 
    Sheets("Sheet2").Select 
    Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select 
    ActiveSheet.Paste 

    'Move counter to next row 
    LCopyToRow = LCopyToRow + 1 

    'Go back to Sheet1 to continue searching 
    Sheets("Sheet1").Select 

    End If 

    LSearchRow = LSearchRow + 1 

Wend 

'Position on cell A3 
Application.CutCopyMode = False 
Range("A3").Select 

MsgBox "All matching data has been copied." 

Exit Sub 

Err_Execute: 
MsgBox "An error occurred." 

End Sub 

Answer 1

这应该适用于Sheet1。但是，您需要明确您想要将值复制到“分析”表单中的哪个位置。

Dim i As Long, j As Long, lR As Long, lastRow As Long, k As Long 
Dim ws As Worksheet 

lastRow = 1 

For k = 1 To ThisWorkbook.Worksheets.Count 
    If Sheets(k).Name <> "Analysis" Then 
     Set ws = Sheets(k) 
     lR = ws.Cells(ws.Rows.Count, 5).End(xlUp).Row 

     For i = 1 To lR 
      If ws.Cells(i, 5).Value = True Then 
       lastRow = lastRow + 1 
       For j = 2 To 4 '2 represents Columns(2) = B and 4 represents Columns(4) = D 
        If ws.Cells(i, j).Value <> "" Then 
         ThisWorkbook.Worksheets("Analysis").Cells(lastRow, j - 1).Value = ws.Cells(i, j) 
        End If 
       Next j 
      End If 
     Next i 
    End If 
Next k