英文:
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
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论