在VBA中循環遍歷一行以複製整行

Question

我正在嘗試循環遍歷從第14行開始的第K列直到結束。我寫了下面的代碼，但它在Range（「K14：」）行停止工作。我嘗試使用Range（「K14」& Rows.Count），但這也沒有幫助。

Windows("Price VolatilityDM.xlsm").Activate 
Sheets("Volatility Static Data").Activate 
Dim x As Single 
Dim Cell As Range 
For Each Cell In Range("K14:") 
    If Cell.Value > 0.25 Then 
     Sheets("Volatility Static Data").Range("B:K").Copy 
     Windows("Tolerance ReportDM.xslm").Activate 
     Sheets("Sheet1").Range("K17:Q17").Paste 
    End If 
Next Cell 

Answer 1

Windows("Price VolatilityDM.xlsm").Activate 
Sheets("Volatility Static Data").Activate 
Set sh = ThisWorkbook.Workheets("Volatility Static Data") ' add a reference to the sheet for simplicity 
Dim x As Single 
Dim Cell As Range 
Dim lastRow 
lastRow = sh.Cells(sh.Rows.Count, "K").End(xlUp).Row ' get the last row 
For Each Cell In Range("K14:K" & lastRow) 
    If Cell.Value > 0.25 Then 
     Sheets("Volatility Static Data").Range("B:K").Copy 
     Windows("Tolerance ReportDM.xslm").Activate 
     Sheets("Sheet1").Range("K17:Q17").Paste 
    End If 
Next Cell 

你只需要找到Range對象的末尾，並確保您遍歷了這一點。往上看;如果有任何問題，請告訴我。

Answer 2

它停在那裏，因爲你還沒有完成整個範圍的寫作。 "K14:"是無效的語法。例如，你可以這樣做："K14:K" & LastRow

Answer 3

你可以使用這樣的事情找K列月底開始在14：

dim end as range 
set cell = range("K14") 

'go down one cell at a time until you find that 
'the next one is empty. This is the end of the column 

do while not cell.offset(1,0).value = "" 

    set cell = cell.offset(1,0) 
loop 
set end = cell 

然後用for each cell in range("K14:" & end.address)

在你的代碼，它會看起來像這樣：

Windows("Price VolatilityDM.xlsm").Activate 
Sheets("Volatility Static Data").Activate 
Dim x As Single 
Dim Cell As Range 
dim end as range 

set cell = range("K14") 
'go down one cell at a time until you find that 
'the next one is empty. This is the end of the column 

do while not cell.offset(1,0).value = "" 
    set cell = cell.offset(1,0) 
loop 
set end = cell 
For Each Cell In Range("K14:" & end.address) 
    If Cell.Value > 0.25 Then 
     Sheets("Volatility Static Data").Range("B:K").Copy 
     Windows("Tolerance ReportDM.xslm").Activate 
     Sheets("Sheet1").Range("K17:Q17").Paste 
    End If 
Next Cell