CODEWITHSUNDEEP
excelvba
Forbidden
Forbidden

Reputation: 45

Type mismatch error on copying ranges.

I am trying to make this work, but it says Type mismatch. Any help on what I am doing wrong? (I am very new to this)

Sub Copy_paste_XP()

Dim wsI As Worksheet
Dim aCell As Range, rngCopyFrom As Range, rng As Range
Dim lRow As Long

Set wsI = ThisWorkbook.Sheets("Move containers XP")

Set rng = ("E2:E500")

For Each aCell In rng
    If Len(Trim(aCell.Value)) <> 0 Then
        If rngCopyFrom Is Nothing Then
            Set rngCopyFrom = aCell
        Else
            Set rngCopyFrom = Union(rngCopyFrom, aCell)
        End If
    End If
Next

If Not rngCopyFrom Is Nothing Then rngCopyFrom.Copy

Range("K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set rng = ("F2:F500")

For Each aCell In rng
    If Len(Trim(aCell.Value)) <> 0 Then
        If rngCopyFrom Is Nothing Then
            Set rngCopyFrom = aCell
        Else
            Set rngCopyFrom = Union(rngCopyFrom, aCell)
        End If
    End If
Next

If Not rngCopyFrom Is Nothing Then rngCopyFrom.Copy
Range("K501").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

Upvotes: 0

Views: 711

Answers (2)

WGS
WGS

Reputation: 14169

First off, you are not setting the variables correctly. You used Set rng = ("E2:E500") when it should be Set rng = wsI.Range("E2:E500").

Also, the macro can be made more flexible. The following code should work:

Sub CopyNotZero(SrcRng As Range, DestRng As Range)
    Dim Cell As Range, RngToCopy As Range
    For Each Cell In SrcRng
        If Cell.Value <> 0 And Len(Cell.Value) <> 0 Then
            If RngToCopy Is Nothing Then
                Set RngToCopy = Cell
            Else
                Set RngToCopy = Union(RngToCopy, Cell)
            End If
        End If
    Next Cell
    If Not RngToCopy Is Nothing Then
        RngToCopy.Copy
        DestRng.PasteSpecial xlPasteValues
    End If
    Set RngToCopy = Nothing
End Sub

Use it like this:

Sub Test()
    Dim wsI As Worksheet: Set wsI = ThisWorkbook.Sheets("Move containers XP")
    With wsI
        CopyNotZero .Range("E1:E500"), .Range("K2")
        CopyNotZero .Range("F1:F500"), .Range("K501")
    End With
End Sub

This will skip all cells with 0 value or no values at all.

Screenshots:

Set-up:

enter image description here

Result after running Test():

enter image description here

Hope this helps.

EDIT:

To call this macro everytime you paste to $A$2, the following code will work (modify accordingly):

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then
        CopyNotZero Range("A1:A500"), Range("K2")
    End If
End Sub

Hope this helps.

Upvotes: 2

Siddharth Rout
Siddharth Rout

Reputation: 149287

E2:E500 <---- This is selected for me. I am trying to make it copy e2:e500 and paste by value in K2 then copy f2:f500 and then paste them by Value in K501 while excluding 0's or blanks – Forbidden 9 mins ago

Set rng = ("E2:E500")

You are missing the word Range. Change it to

Set rng = wsI.Range("E2:E500")

EDIT

Similarly for Set rng = ("F2:F500")

Also this seems to be a followup from your PREV question. I see you are still using .Select ;)

Upvotes: 0

Related Questions