Excel 如何仅复制循环中的前4列

我试图使用这里找到的代码的几个部分从电子表格复制到另一个电子表格，但是在进行一些调整后，我遇到了一个问题，在将值从sheet1复制到sheet2后，它复制了所有2000列，而我只需要它来复制前4列，我还需要复制“TC1”下的所有内容

请注意，TC1将在每个工作表上列出3次

我的简历中有一个问题，就是我只想复制前4列 2在TC1的末尾和列1中列出的下一个之间有2个或更多的空格 3它只是在到达TC1的最后一行之前复制前几行，而不是整个列表

    'VBA Open excel to copy TC to master list Dir
Sub Copy_Paste__To_New_Sheet()

    'Variable Declaration
    Dim sFilePath As String
    Dim sFileName As String
    Dim wb As Excel.Workbook
    Dim rngCopy As Range, acell As Range, bcell As Range
    Dim strSearch As String
    Dim strFile As Variant
    Dim wb2 As Excel.Workbook


    'Specify File Path
    sFilePath = "C:\temp\new"

    'Check for back slash
    If Right(sFilePath, 1) <> "\" Then
        sFilePath = sFilePath & "\"
    End If

    sFileName = Dir(sFilePath)

    Do While Len(sFileName) > 0
    Set rngCopy = Nothing
    Application.DisplayAlerts = False
    Set wb = Workbooks.Open(Filename:=sFilePath & sFileName)
        Sheets("TestCases").Activate
'        Range("E:E").Insert
        'Display file name in immediate window
'        Debug.Print sFileName
        strSearch = "TC1"

    Set WS = Worksheets("TestCases")

    With WS
        Set acell = .Columns(1).Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

        If Not acell Is Nothing Then
            Set bcell = acell

            If rngCopy Is Nothing Then
                Set rngCopy = WS.Range(WS.Cells(acell.Row + 1, 1), WS.Cells(acell.Row + 2, 4))
            Else
                Set rngCopy = Application.Union(rngCopy, .Rows((acell.Row + 1) & ":" & (acell.Row + 2)))
            End If

            Do
                Set acell = .Columns(1).FindNext(After:=acell)

                If Not acell Is Nothing Then
                    If acell.Address = bcell.Address Then Exit Do

                    If rngCopy Is Nothing Then
                        Set rngCopy = WS.Range(WS.Cells(acell.Row + 1, 1), WS.Cells(acell.Row + 2, 4))
                    Else
                        Set rngCopy = Application.Union(rngCopy, .Rows((acell.Row + 1) & ":" & (acell.Row + 2)))
                    End If
                Else
                    Exit Do
                End If
            Loop
        Else
            MsgBox SearchString & " not Found"
        End If

        '~~> I am pasting to Output sheet. Change as applicable

            Set wb2 = Workbooks.Open("C:\temp\output\outputtest.xlsx")
            If Not rngCopy Is Nothing Then Sheets("Output").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(rngCopy.Rows.Count, 4).Value = rngCopy.Value

'            If Not rngCopy Is Nothing Then Sheets("Output").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 4).Value = rngCopy.Value
'        If Not rngCopy Is Nothing Then rngCopy.Copy Sheets("Output").Cells(1, 1).Resize(rngCopy.Rows.Count, rngCopy.Columns.Count)
'        .End (xlDown) + 1
'        Sheets("Output").Rows(1)
        Application.DisplayAlerts = False
        wb2.Close savechanges = False

    End With

您每次都将rngCopy设置为整行。这意味着它将复制该行的所有列。相反，您需要将rngCopy设置为仅包括前4列。你可以这样做

Set rngCopy = WS.Range(WS.Cells(acell.Row + 1, 1), WS.Cells(acell.Row + 2, 4))

而不是

Set rngCopy = .Rows((acell.Row + 1) & ":" & (acell.Row + 2))

---

谢谢@Alex de Jong，我现在看到了我的错误，但我现在得到了一个运行时错误1004，此操作在多个选择上不起作用。您在设置rngCopy的所有不同位置都这样做了吗？我猜您在Union函数中遇到此错误是因为您试图将整行与两个单元格组合。您是正确的，我在这里得到它“如果不是rngCopy，则rngCopy.Copy SheetsOutput.Rows1”您必须将rngCopy复制到SheetsOutput.Cells1，1.ResizerngCopy.row.count，rngCopy.Columns.count以使两个范围的大小匹配。抱歉，请问，您能否指导如何编辑该行，我不断收到错误，它显示无效限定符