I need help with an excel VBA code for a sch. proj. pls. The code moves contents from a "2C" sheet when cell contains the text "Less Than 30" to a final sheet name "<30day." The current code moves the entire column from "2C" to column A in "Less Than 30", I want it to move it to column B in "Less Than 30" because I want to put something in column A. The current code clears what I put in column A of "Less Than 30" when run.

Im not a coder and this code is from a YouTuber (Excel 10)

Below is the attached code.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Z As Long

Dim xVal As String

On Error Resume Next

If Intersect(Target, Range("AK:AK")) Is Nothing Then Exit Sub

Application.EnableEvents = False

For Z = 1 To Target.Count

If Target(Z).Value > 0 Then

Call CopyRowBasedOnCellValue

End If

Next

Application.EnableEvents = True

End Sub

Sub CopyLessThan30Days2C()

Dim xRg As Range

Dim xCell As Range

Dim A As Long

Dim B As Long

Dim C As Long

A = Worksheets("2C").UsedRange.Rows.Count

B = Worksheets("<30days").UsedRange.Rows.Count

If B = 1 Then

If Application.WorksheetFunction.CountA(Worksheets("<30days").UsedRange) = 0 Then B = 0

End If

Set xRg = Worksheets("2C").Range("AK1:AK" & A)

On Error Resume Next

Application.ScreenUpdating = False

For C = 1 To xRg.Count

If CStr(xRg(C).Value) = "Less Than 30" Then

xRg(C).EntireRow.Copy Destination:=Worksheets("<30days").Range("A" & B + 1)

B = B + 1

End If

Worksheets("<30days").UsedRange.RemoveDuplicates Columns:=1, Header:=xlYes

Worksheets("<30days").UsedRange.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp

Next

Application.ScreenUpdating = True

End Sub