在存档中粘贴数值?

huangapple go评论60阅读模式
英文:

Paste Values on Archive?

问题

我希望你能帮忙?

当单元格变为“closed”时,我想要存档数据。

我找到了以下代码,但我需要将数值粘贴到存档中,以便时间不会不断更新。

Sub MoveRowsToNextTab()
    'ExcelIsSimple-Subscribe at http://www.youtube.com/user/excelissimple?sub_confirmation=1
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("CSL").UsedRange.Rows.Count
    J = Worksheets("Archive").UsedRange.Rows.Count
    If J = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Archive").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("CSL").Range("C7:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Closed" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Archive").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Closed" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

任何想法... PS我不知道我在做什么 在存档中粘贴数值?

尝试在以下代码之后添加:

PasteSpecial xlPasteValues

在这段代码:

xRg(K).EntireRow.Copy Destination:=Worksheets("Archive").Range("A" & J + 1)

但是这并没有起作用。

英文:

hoping you can help?

I am wanting to archive data when a cell turns to "closed"

I have found the following code but i need it to past VALUES into the Archive so that times dont keep updating?

Sub MoveRowsToNextTab()
'ExcelIsSimple-Subscribe at http://www.youtube.com/user/excelissimple?sub_confirmation=1
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("CSL").UsedRange.Rows.Count
    J = Worksheets("Archive").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Archive").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("CSL").Range("C7:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Closed" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Archive").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Closed" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Any ideas.... PS I have no idea what i am doing 在存档中粘贴数值?

tried adding

PasteSpecial xlPasteValues 

after

xRg(K).EntireRow.Copy 
Destination:=Worksheets("Archive").Range("A" & J + 1)

but that did not work

答案1

得分: 1

尝试

Sub MoveToArchive()
    Dim wsCSL As Worksheet
    Dim wsArchive As Worksheet
    Dim lastRowCSL As Long
    Dim lastRowArchive As Long
    Dim i As Long
    
    Application.ScreenUpdating = False
    ' 设置工作表
    Set wsCSL = ThisWorkbook.Worksheets("CSL")
    Set wsArchive = ThisWorkbook.Worksheets("Archive")
    
    ' 查找CSL列C中的最后一行
    lastRowCSL = wsCSL.Cells(wsCSL.Rows.Count, "C").End(xlUp).Row
    
    ' 以逆序循环遍历行
    For i = lastRowCSL To 7 Step -1
        ' 检查列C中的值是否为"Closed"
        If CStr(wsCSL.Cells(i, "C").Value) = "Closed" Then
            ' 查找存档列A中的下一个空行
            lastRowArchive = wsArchive.Cells(wsArchive.Rows.Count, "A").End(xlUp).Row
            wsCSL.Rows(i).Cut Destination:=wsArchive.Cells(lastRowArchive + 1, "A")
            wsCSL.Rows(i).Delete
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "归档完成。"
End Sub
英文:

try

Sub MoveToArchive()
    Dim wsCSL As Worksheet
    Dim wsArchive As Worksheet
    Dim lastRowCSL As Long
    Dim lastRowArchive As Long
    Dim i As Long
    
    Application.ScreenUpdating = False
    ' Set the worksheets
    Set wsCSL = ThisWorkbook.Worksheets("CSL")
    Set wsArchive = ThisWorkbook.Worksheets("Archive")
    
    ' Find the last row in CSL column C
    lastRowCSL = wsCSL.Cells(wsCSL.Rows.Count, "C").End(xlUp).Row
    
    ' Loop through the rows in reverse order
    For i = lastRowCSL To 7 Step -1
        ' Check if the value in column C is "Closed"
        If CStr(wsCSL.Cells(i, "C").Value) = "Closed" Then
            ' Find the next empty row in Archive column A
            lastRowArchive = wsArchive.Cells(wsArchive.Rows.Count, "A").End(xlUp).Row
            wsCSL.Rows(i).Cut Destination:=wsArchive.Cells(lastRowArchive + 1, "A")
            wsCSL.Rows(i).Delete
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "Archived complete."
End Sub

huangapple
  • 本文由 发表于 2023年6月6日 17:07:59
  • 转载请务必保留本文链接:https://go.coder-hub.com/76413054.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定