Question

所以我的问题是这个。我有一张工作簿，可以说2张。我已经从另一个程序和sheet1自动创建了sheet2，我只想从sheet2获得一些信息。

我现在正在尝试创建一个宏，它将检查从14开始的每一行，其中E％中的值大于15.如果条件满足，我希望宏将单元格值从C％和E％复制到sheet1让我们在A5和B5中说，然后进入sheet2中的下一行，将值粘贴到A6 B6，依此类推。

Sub Test()
    Dim rng As Range
    Dim lastRow As Long
    Dim cell As Variant


    With Sheets("Sheet2")


        lastRow = .Range("E" & .Rows.Count).End(xlUp).Row
        Set rng = .Range("E14:E" & lastRow)


        For Each cell In rng
            If cell.Value > 15 Then
            'And here is where it gets bugged. I know theres something wrong with the .select but I couldnt think of any other way to
            'pick only just the 2 cells needed.
                Range(cell.Offset(0, -1), cell.Offset(0, 0)).Select
                Selection.Copy

                'In here there should also be some code to select where to place the copyed
                'data but since it already got bugged couldnt really find a solution for 
                'it..
                Sheets("Sheet1").Select
                ActiveSheet.Paste
                Sheets("Sheet2").Select

            End If
        Next
    End With


End Sub

Answer 1

所以我想我会把它放在一起：

Sub Test()
Dim rng As Range
Dim lastRow As Long
Dim cell As Variant
dim count as long
count = 0

With Sheets("Sheet2")


    lastRow = .Range("E" & .Rows.Count).End(xlUp).Row
    Set rng = .Range("E14:E" & lastRow)


    For Each cell In rng
        If cell.Value > 15 Then
        'And here is where it gets bugged. I know theres something wrong with the         .select but I couldnt think of any other way to
        'pick only just the 2 cells needed.
            Range(cell.Offset(0, -1), cell.Offset(0, 0)).Select
            Selection.Copy
        'maybe use: Range(cell.Offset(0, -1), cell.Offset(0, 0)).copy


            'In here there should also be some code to select where to place the copyed
            'data but since it already got bugged couldnt really find a solution for 
            'it..
            Sheets("Sheet1").Activate
            Range("A5", B5).offset(count, 0).PasteSpecial 'this will make it so that it starts in a5, and moves down a row each time
            count = count + 1            'dont forget to increment count

            Sheets("Sheet2").Activate

        End If
    Next
End With


End Sub

这有点粗糙......

您可能会包含一些错误处理，例如：if not cell.value = "" then或if not isNumeric(cell.value) then，这些错误处理将确保您只处理带有数字的非空白单元格。

如果满足某些条件，如何从另一个工作表中的每一行复制特定单元格？

1 个答案: