如果一個單元格> 10複製並粘貼到工作表2

Question

我正在使用Excel 2007電子表格進行工作，我需要在「工作表1」上取值，如果它大於10，我需要整個列，並通過它'表2'。

我該怎麼做？我會在哪裏開始？

UPDATE：

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，從去年發佈照片刪除

OK，讓我們試試這個代替。你有這樣的工作簿中開始了：

嘗試運行代碼的這種修改：

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

選擇第一個片材上的測試單元並運行：

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

注：

我使用Sheet 2中而非表2

EDIT＃1 ：

這個版本將遍歷所有列在第一板和列複製到Sheet2中如果在列中的某些細胞具有大於10的值：在第一層上

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