Question

以下代码仅将“firstsheet”中列的最后一个值复制到新工作表“secondsheet”中。有人可以帮我将表格从“firstsheet”复制到“秒表”，匹配条件是RGB（255,255,0）。

Sub CopyColumns()

        Dim ws As Worksheet
      //  Set ws = Worksheets("secondsheet")

     For Each c2 In Worksheets("secondsheet").Range("B4:B80").Cells
        For Each c In Worksheets("firstsheet").Range("C3:C79").Cells
            If c.Interior.Color = RGB(255, 255, 0) Then
            c2.Value = c.Value
            c2.Interior.Color = RGB(255, 0, 255)
            End If
        Next c
     Next c2





    End Sub

Answer 1

我的捅是在下面。有几件事......你不需要循环，让内置功能完成繁重的任务。这也假设B3在＆＃34; firstsheet＆＃34;是一个标题，你希望数据进入＆＃34;秒表＆＃34;的C4。我的猜测是你必须调整范围以适应。当结构发生变化（变大）时，这也将处理数据。它还假设您使用的是Excel2007或更高版本：

Sub test()

With Application
    .ScreenUpdating = False
End With

Dim lastRow As Long

With Sheets("secondsheet")
    lastRow = Application.Max(4, .Range("C1048576").End(xlUp).Row)
    .Range("C4:C" & lastRow).Delete Shift:=xlUp
End With

With Sheets("firstsheet")
    lastRow = .Range("B1048576").End(xlUp).Row
    .Range("B3:B" & lastRow).AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
    .Range("B4:B" & lastRow).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("secondsheet").Range("C4")
    .Range("B3:B" & lastRow).AutoFilter
End With

With Application
    .ScreenUpdating = True
End With
End Sub

想要将修改后的列数据+未修改的数据从一个工作表复制到另一个工作表

1 个答案: