Run Time Error 424 Object required

[ipbr21054]

Hi,
I was advised a very good code by @RoryA & decided to use it again.
I have changed worksheet names & copy / paste columns etc but im getting a RTE of 424 OBJECT REQUIRED when i run it.
Can you point me in the direction of finding the cause please

This is the code in use shown below

Private Sub Kdx2_Click()
    
    Dim WB As Workbook, DestWB As Workbook
    Dim ws As Worksheet, DestWS As Worksheet
    Dim rng As Range, rngDest As Range
    Dim ColArr As Variant, SCol As Variant, DCol As Variant
 
    On Error Resume Next
    Set DestWB = Application.Workbooks("CLONING-KDX2.xlsm")

    If DestWB Is Nothing Then
        Workbooks.Open fileName:="C:\Users\Ian\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\CLONING-KDX2.xlsm"
        Set DestWB = Application.Workbooks("CLONING-KDX2.xlsm")
    End If
    On Error GoTo 0

    Set WB = ThisWorkbook
    On Error Resume Next
    Set ws = WB.Worksheets("DATABASE")
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "Worksheet 'DATABASE' IS MISSING"
        Exit Sub
    End If
 
    Set DestWS = DestWB.Worksheets("CLONING")
    ColArr = Array("A:A", "D:B", "G:C", "N:D", "M:E", "L:F", "I:G")
    Dim DestNextRow As Long
    With DestWS
        If IsEmpty(.Range("A" & 1)) Then
            DestNextRow = 1
        Else
            DestNextRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        End If
    End With

    Application.ScreenUpdating = False
    For Each SCol In ColArr
        DCol = Split(SCol, ":")(1)
        SCol = Split(SCol, ":")(0)
        With ws
            Set rng = .Cells(Target.Row, SCol)
        End With

        With DestWS
            Set rngDest = .Range(DCol & DestNextRow)
        End With
        rng.Copy
        rngDest.PasteSpecial PASTE:=xlPasteValues
        
        rngDest.Borders.Weight = xlThin
        rngDest.Font.Size = 16
        rngDest.Font.Bold = True
        rngDest.HorizontalAlignment = xlCenter
        rngDest.Cells.Interior.ColorIndex = 6
        rngDest.Cells.RowHeight = 25
    Next SCol
    Application.ScreenUpdating = True
   
 
With ActiveWorkbook ' THIS WILL SAVE & CLOSE CLONING-KDX2 WORKBOOK
   .Save
   .Saved = True
   .Close
End With

End Sub

 

[MARK858]

Add the 3 lines in red, run the code, what do the 3 message boxes state?

        SCol = Split(SCol, ":")(0)
        
        MsgBox ActiveCell.Row
        MsgBox "'" & ActiveCell.Parent.Name & "'!" & ActiveCell.Address(External:=False)
        
        With ws
            Set rng = .Cells(ActiveCell.Row, SCol)
        End With

        With DestWS
            Set rngDest = .Range(DCol & DestNextRow)
        End With
        
        MsgBox rng.Address
        
        rng.Copy
        rngDest.PasteSpecial Paste:=xlPasteValues

 

[ipbr21054]

Red lines added and as follows
15
KDX2LIST$A$15
SA$15

Pressing OK then does the same but 15 value becomes 8 followed by B,C,D etc etc
So same as above etc

8
KDX2LIST$B$8
SB$8

8
KDX2LIST$C$8
SC$8

And so on

 

[MARK858]

Then your activecell.row is changing probably because your ActiveCell is on Sheet KDX2LIST and it should be cell A6 on sheet DATABASE if you are using ActiveCell, as that is the sheet ws is set as.

Why not just use 6 rather than Activecell.row as you already know the row is 6?

 

[ipbr21054]

Yes using ActiveCell
So can this be fixed or should i wait for the member who advised the original code which when i see run flies through it.

 

[MARK858]

Why not just use 6 rather than Activecell.row as you already know the row is 6?

 

[ipbr21054]

That did the trick,i just selected one you advised.
Changing it to 6 worked.

Should i start a new post for only allowing it to run if A6 is active ?

 

[MARK858]

    If ActiveSheet.Name = "DATABASE" And ActiveCell.Address = "$A$6" Then

        With ws
            Set rng = .Cells(6, SCol)
        End With

        With DestWS
            Set rngDest = .Range(DCol & DestNextRow)
        End With

        rng.Copy
        rngDest.PasteSpecial Paste:=xlPasteValues
        
    
        ' + WHATEVER OTHER CODE YOU WANT TO RUN
       
    Else
        MsgBox "Yu Must Select Cell A6"
        Exit Sub
       
    End If

 

[ipbr21054]

Many thanks with you input tonight.
Now all sorted

 

[MARK858]

You're welcome