簡體   English   中英

遍歷VBA中的列以復制整行

[英]Looping through a Column in VBA to copy an entire row

我試圖循環遍歷從第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
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對象的末尾並確保您遍歷該對象即可。 往上看; 如有任何疑問,請告訴我。

因為您尚未完成整個范圍的編寫,所以它在那里停止。 "K14:"是無效的語法。 例如,您可以這樣做: "K14:K" & LastRow

您可以使用以下方法找到以14開始的K列的結尾:

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM