將來自不同工作表的特定列的行內容真實複製到特定工作表中

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