Question

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

我想让宏进入工作表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

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

1 个答案: