vba code to correct

[JCKTDS123456]

Dear sir,

I have a vba code that is working nice but problem is that while importing data, font size, conditional formatting etc.....is also importing along with............so please I want value to be imported to the next worksheet.............and for your king refference.........i am sending you model file...............please correct that vba code

Option Explicit


Sub copyDatabyCondition()
    'copy data if column C isn't empty
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    
    Dim LastCell, i As Long
    
    'intialization
    Set wsSource = ThisWorkbook.Sheets("Sheet2")
    Set wsTarget = ThisWorkbook.Sheets("Sheet3")
    
    'find the last row in both tables
    LastCell = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    With wsSource
        'for each row in the source table
        For i = 4 To LastCell
            'column C isn't empty?
            If .Cells(i, "A") > 0 And .Cells(i, "C") = 0 Then
                wsSource.Range("A" & i & ":C" & i).Copy wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1, 0)
                wsSource.Range("F" & i).Copy wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(, 5)
                wsSource.Range("N" & i).Copy wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(, 13)
            End If
        Next
    End With
End Sub

 

[Yongle]

This copies everything

wsSource.Range("A" & i & ":C" & i).Copy wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1, 0)

This method pastes values only

wsSource.Range("A" & i & ":C" & i).Copy
wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)

 

[dmt32]

Hi,
untested but see if this update to your code does what you want

Option Explicit
Sub CopyDataByCondition()
    'copy data if column C isn't empty
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim LastCell, i As Long
    
    Set wsSource = ThisWorkbook.Sheets("Sheet2")
    Set wsTarget = ThisWorkbook.Sheets("Sheet3")
    
'for each row in the source table
        For i = 4 To wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
            'column C isn't empty?
            If wsSource.Cells(i, "A") > 0 And wsSource.Cells(i, "C") = 0 Then
                With wsTarget
                LastCell = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                    With .Cells(LastCell, 1)
                        .Resize(, 3).Value = wsSource.Range("A" & i).Resize(, 3).Value
                        .Offset(, 5).Value = wsSource.Range("F" & i).Text
                        .Offset(, 13).Value = wsSource.Range("N" & i).Text
                    End With
                End With
            End If
        Next
End Sub

Dave


Always make a backup before testing new code.

 

[Domenic]

Here's also another way...

With wsSource.Range("A" & i & ":C" & i)
    wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With