Copy only cells with values

[Romano_odK]

Good afternoon,

Now I have a macro to copy a colum to another column in a table, but what I really need is when the column is copied that only the filled in values are copied. Is that possible?

Thank you for your time,

Romano


Private Sub KopieerNaarVerkoopprijs_Click()
With Sheets("OPXML").ListObjects("Table_Query_from_A100")
.ListColumns(3).DataBodyRange.Value = .ListColumns(4).DataBodyRange.Value
End With
End Sub

 

[Zot]

It helps if you tell how those copied values are arragned in the destination locations. Best if you can give illustration

 

[Romano_odK]

It helps if you tell how those copied values are arragned in the destination locations. Best if you can give illustration

It helps if you tell how those copied values are arragned in the destination locations. Best if you can give illustration

Good afternoon,

You got a point. OK so I added a small part of the sheet just to give an idea what I need. With the mentioned macro I need the values who are a part of table to be copied from column D to C without the blanks in D overwriting the values in column C.

Thank you in advance.


Private Sub KopieerNaarVerkoopprijs_Click()
With Sheets("OPXML").ListObjects("Table_Query_from_A100")
.ListColumns(3).DataBodyRange.Value = .ListColumns(4).DataBodyRange.Value
End With
End Sub

 

[Fluff]

How about

Private Sub KopieerNaarVerkoopprijs_Click()
With Sheets("OPXML").ListObjects("Table_Query_from_A100")
   .ListColumns(4).DataBodyRange.Copy
   .ListColumns(3).DataBodyRange.PasteSpecial xlPasteValues, , True
   Application.CutCopyMode = False
End With
End Sub

 

[Romano_odK]

How about

Private Sub KopieerNaarVerkoopprijs_Click()
With Sheets("OPXML").ListObjects("Table_Query_from_A100")
   .ListColumns(4).DataBodyRange.Copy
   .ListColumns(3).DataBodyRange.PasteSpecial xlPasteValues, , True
   Application.CutCopyMode = False
End With
End Sub

Exactly what I needed, thank you for your time and solution.

Have a nice day,

Romano

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[Romano_odK]

Exactly what I needed, thank you for your time and solution.

Have a nice day,

Romano

Oh one little thing. Is is also possible to not overwrite when a cell in column D is empty. Now it overwrites values in column C when there is no value in a cell in column D.
Thank you.

 

[Tupe77]

Is this usable for your needs?

Sub TS_CopyNonEmpty()
Dim DRng As Range, CRng As Range
Dim DArr As Variant, CArr As Variant

With Sheets(1)
    rw = .Range("C65536").End(xlUp).row + 1
        Set CRng = .Range("C2" & ":" & "C" & rw)
        Set DRng = .Range("D2" & ":" & "D" & rw)
        
        CArr = CRng.Value
        DArr = DRng.Value

        For i = LBound(CArr, 1) To UBound(CArr, 1)
            If Len(DArr(i, 1)) > 0 Then CArr(i, 1) = DArr(i, 1)
        Next i

End With

CRng.Value = CArr

End Sub

 

[Fluff]

But that's what the code does & you said it worked.

 

[Romano_odK]

Is this usable for your needs?

Sub TS_CopyNonEmpty()
Dim DRng As Range, CRng As Range
Dim DArr As Variant, CArr As Variant

With Sheets(1)
    rw = .Range("C65536").End(xlUp).row + 1
        Set CRng = .Range("C2" & ":" & "C" & rw)
        Set DRng = .Range("D2" & ":" & "D" & rw)
       
        CArr = CRng.Value
        DArr = DRng.Value

        For i = LBound(CArr, 1) To UBound(CArr, 1)
            If Len(DArr(i, 1)) > 0 Then CArr(i, 1) = DArr(i, 1)
        Next i

End With

CRng.Value = CArr

End Sub

Thank you, but now its does not overwrite the values in de column C unfortunately.