[英]Copy All cells from A + AC in sheet1 to Sheet3 then delete row in Sheet1
I´m currently using following code to based on value in Column J copy code to two different sheets. 我目前正在使用以下代码基于J列中的值将代码复制到两个不同的工作表中。
I am copying values from cell A to AC to sheet3 if the value in J is "ENDED-LOCATION" how can I write that prettier? 如果J中的值是“ ENDED-LOCATION”,我将值从单元格A复制到AC到sheet3,如何写得更漂亮? I also would like to delete the row in Sheet1 after the copy is done.
复制完成后,我也想删除Sheet1中的行。 What can I do to manage that?
我该怎么办?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Main As Worksheet, Secondary As Worksheet, Third As Worksheet
Dim iCell As Range, FoundRange As Range, FoundRange2 As Range
Dim lRow As Long, NextRow As Long
' Define worksheets for simplicity
With ThisWorkbook
Set Main = .Worksheets("Sheet1")
Set Secondary = .Worksheets("Sheet2")
Set Third = .Worksheets("Sheet3")
End With
' Calculate last row on Sheet2 (by column "A")
lRow = Secondary.Range("A" & Secondary.Rows.Count).End(xlUp).Row
' Calculate last row on Sheet3 (by column "A")
NextRow = Third.Range("A" & Secondary.Rows.Count).End(xlUp).Row
' Check if changes were made in columns "J" (Information)
' If changes weren't made in column "J" leave this sub
If Intersect(Target, Main.Columns("J")) Is Nothing Then Exit Sub
' Loop through each changed cell of column "J"
For Each iCell In Intersect(Target, Main.Columns("J")).Cells
' Find location on Sheet2
'Main.Range("A" & iCell.Row).Value
Set FoundRange = Secondary.Range("A2:A" & lRow).Find(Main.Range("A" & iCell.Row).Value, , xlValues, xlWhole)
Set FoundRange2 = Third.Range("A2:A" & NextRow).Find(Main.Range("A" & iCell.Row).Value, , xlValues, xlWhole)
' If value of the changed cell is "NEW-LOCATION"..
If iCell.Value = "NEW-LOCATION" Then
' And it didn't find this location on Sheet2..
If FoundRange Is Nothing Then
' Add new location
Secondary.Range("A" & lRow + 1).Value = Main.Range("A" & iCell.Row).Value
Secondary.Range("B" & lRow + 1 & ":D" & lRow + 1 & "").Value = Main.Range("C" & iCell.Row & ":E" & iCell.Row & "").Value
lRow = lRow + 1
End If
' If value of the changed cell is "ENDED-LOCATION".
ElseIf iCell.Value = "ENDED-LOCATION" Then
' Add new location
' And it didn't find this location on Sheet3..
If FoundRange2 Is Nothing Then
Third.Range("A" & NextRow + 1).Value = Main.Range("A" & iCell.Row).Value
Third.Range("B" & NextRow + 1).Value = Main.Range("B" & iCell.Row).Value
Third.Range("C" & NextRow + 1).Value = Main.Range("C" & iCell.Row).Value
Third.Range("D" & NextRow + 1).Value = Main.Range("D" & iCell.Row).Value
Third.Range("E" & NextRow + 1).Value = Main.Range("E" & iCell.Row).Value
Third.Range("F" & NextRow + 1).Value = Main.Range("F" & iCell.Row).Value
Third.Range("G" & NextRow + 1).Value = Main.Range("G" & iCell.Row).Value
Third.Range("H" & NextRow + 1).Value = Main.Range("H" & iCell.Row).Value
Third.Range("I" & NextRow + 1).Value = Main.Range("I" & iCell.Row).Value
Third.Range("J" & NextRow + 1).Value = Main.Range("J" & iCell.Row).Value
Third.Range("K" & NextRow + 1).Value = Main.Range("K" & iCell.Row).Value
Third.Range("L" & NextRow + 1).Value = Main.Range("L" & iCell.Row).Value
Third.Range("M" & NextRow + 1).Value = Main.Range("M" & iCell.Row).Value
Third.Range("N" & NextRow + 1).Value = Main.Range("N" & iCell.Row).Value
Third.Range("O" & NextRow + 1).Value = Main.Range("O" & iCell.Row).Value
Third.Range("P" & NextRow + 1).Value = Main.Range("P" & iCell.Row).Value
Third.Range("Q" & NextRow + 1).Value = Main.Range("Q" & iCell.Row).Value
Third.Range("R" & NextRow + 1).Value = Main.Range("R" & iCell.Row).Value
Third.Range("S" & NextRow + 1).Value = Main.Range("S" & iCell.Row).Value
Third.Range("T" & NextRow + 1).Value = Main.Range("T" & iCell.Row).Value
Third.Range("U" & NextRow + 1).Value = Main.Range("U" & iCell.Row).Value
Third.Range("V" & NextRow + 1).Value = Main.Range("V" & iCell.Row).Value
Third.Range("W" & NextRow + 1).Value = Main.Range("W" & iCell.Row).Value
Third.Range("X" & NextRow + 1).Value = Main.Range("X" & iCell.Row).Value
Third.Range("Y" & NextRow + 1).Value = Main.Range("Y" & iCell.Row).Value
Third.Range("Z" & NextRow + 1).Value = Main.Range("Z" & iCell.Row).Value
Third.Range("AA" & NextRow + 1).Value = Main.Range("AA" & iCell.Row).Value
Third.Range("AB" & NextRow + 1).Value = Main.Range("AB" & iCell.Row).Value
Third.Range("AC" & NextRow + 1).Value = Main.Range("AC" & iCell.Row).Value
NextRow = NextRow + 1
End If
' If value of the changed cell is NOT "NEW-LOCATION"..
Else
' And it found this location in Sheet2..
If Not FoundRange Is Nothing Then
' Delete row with this location
FoundRange.EntireRow.Delete
lRow = lRow - 1
End If
End If
Next
End Sub
Try to use an .AutoFilter. 尝试使用.AutoFilter。
Sub CopyExpired()
With Worksheets("sheet1")
If .AutoFilterMode Then .AutoFilterMode = False
With .Cells(1, "A").CurrentRegion
.AutoFilter field:=10, Criteria1:="ENDED-LOCATION"
With .Resize(.Rows.Count - 1, 29).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1)
.SpecialCells(xlCellTypeVisible).entirerow.delete
End If
End With
End With
If .AutoFilterMode Then .AutoFilterMode = False
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.