如果一个细胞是> 10复制并粘贴到工作表2

Question

我正在使用Excel 2007电子表格进行工作，我需要对“表1”和“表格”进行评估。如果它大于10，我需要整个列并将其过去到表2中。

我该怎么做？我从哪里开始？

更新：

Sub TopComp()


For Each i In Worksheets("All Competition").Range("E32:BL32")
 If i.Value > 9 Then
 ady = i.EntireColumn.Cells(1).Address
 i.EntireColumn.Copy Sheets("Top 10 Competition").Range(ady)
 End If
Next i

End Sub

我现在遇到的问题是粘贴柱子时很棒。它为空的空间留下了空间。有办法解决这个问题吗？

Answer 1

在第一张纸上选择测试单元格并运行：

Sub kolumnizer()
    If ActiveCell.Value > 10 Then
        ady = ActiveCell.EntireColumn.Cells(1).Address
        ActiveCell.EntireColumn.Copy Sheets("Sheet2").Range(ady)
    End If
End Sub

注意：

我使用 Sheet2 而不是 Sheet 2

修改＃1：

如果列中的某些单元格的值大于10，则此版本将遍历第一张工作表中的所有列并将列复制到 Sheet2 ：

Sub kolumnizer()
    Dim i As Long, wf As WorksheetFunction
    Dim nLastColumn As Long, nFirstColumn As Long
    Set wf = Application.WorksheetFunction
    Set r = ActiveSheet.UsedRange
    nLastColumn = r.Columns.Count + r.Column - 1
    nFirstColumn = r.Column
    For i = nFirstColumn To nLastColumn
        Set r = Cells(1, i).EntireColumn
        If wf.Max(r) > 10 Then
            r.Copy Sheets("Sheet2").Cells(1, i)
        End If
    Next i
End Sub

从第一张表开始

修改＃2

第3版允许你选择范围：

Sub kolumnizer3()
    Dim i As Long, wf As WorksheetFunction
    Dim nLastColumn As Long, nFirstColumn As Long
    Set wf = Application.WorksheetFunction
    Set r = Application.InputBox(Prompt:="Pick your range", Type:=8)
    nLastColumn = r.Columns.Count + r.Column - 1
    nFirstColumn = r.Column
    For i = nFirstColumn To nLastColumn
        Set r = Cells(1, i).EntireColumn
        If wf.Max(r) > 10 Then
            r.Copy Sheets("Sheet2").Cells(1, i)
        End If
    Next i
End Sub

Answer 2

编辑＃1，删除了上一篇文章的图片

好的，让我们试试吧。你可以从这样的工作簿开始：

尝试运行代码修改：

Sub TopComp()

Dim i As Range, TargetRng As Range
Dim TargetCounter As Long
Dim AllSheet As Worksheet, TopSheet As Worksheet

'declare worksheets for easy reference
Set AllSheet = ThisWorkbook.Worksheets("All Competition")
Set TopSheet = ThisWorkbook.Worksheets("Top 10 Competition")

For Each i In AllSheet.Range("E32:BL32")
    If i.Value > 9 Then
        TargetCounter = TargetCounter + 1
        Set TargetRng = TopSheet.Cells(1, TargetCounter).EntireColumn
        i.EntireColumn.Copy TargetRng
    End If
Next i

End Sub

这应该给你以下，这是我认为你想要的：

-

酷 - 让我们假设您从这样的工作簿开始：

您可以运行此代码来填充结束值为＆gt;的列。 10：

Option Explicit
Sub CheckColumns()

Dim LastCol As Long, LastRow As Long, _
    ColIdx As Long, TargetColCounter As Long
Dim SheetOne As Worksheet, SheetTwo As Worksheet
Dim ColRng As Range, TargetRng As Range

'assign sheets for easy reference
Set SheetOne = ThisWorkbook.Worksheets("Sheet1")
Set SheetTwo = ThisWorkbook.Worksheets("Sheet2")

'identify the last row and last column to set bounds on loop
LastRow = SheetOne.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = SheetOne.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

'loop through the columns
For ColIdx = 1 To LastCol

    If SheetOne.Cells(LastRow, ColIdx).Value > 10 Then
        TargetColCounter = TargetColCounter + 1
        Set ColRng = Range(SheetOne.Cells(1, ColIdx), SheetOne.Cells(LastRow, ColIdx))
        Set TargetRng = Range(SheetTwo.Cells(1, TargetColCounter), SheetTwo.Cells(LastRow, TargetColCounter))
        ColRng.Copy TargetRng
    End If

Next ColIdx

End Sub