如果一个单元格> 10复制并粘贴到表单2

我正在做一个Excel 2007 Spreadsheet的工作，我需要在“Sheet 1”上取值，如果它大于10，我需要取一整列并将其过滤到“Sheet 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

编辑＃1，删除了最后一个post的图片

好的，我们来试试这个。 你从这样的工作簿开始：

尝试运行您的代码的这种修改：

 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 

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

–

酷 – 比方说，你开始看起来像这样的工作簿：

您可以运行此代码来填充结束值> 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 

Answer 2

select第一张纸上的testing单元并运行：

 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允许您select范围：

 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