macro to copy/paste data - edit required

[bluepenink]

hi guys....can someone assist with the following macro


essentially, i want the macro to copy/paste where there is a value > 0 or <>"" in column Y from the "data" tab.


the current macro is copy/pasting everything ...thx you in advance!

Sub _Merge()
    
    Dim rngCopy As Range, LR As Long
    
    With Sheets("OUT")
    
        'Clear old data
        If .Range("A8") <> Empty Then .Range("A8", .Range("A" & Rows.Count).End(xlUp)).EntireRow.ClearContents
        
        'Copy 
        With Sheets("Data")
            LR = .Range("B" & Rows.Count).End(xlUp).Row
            Set rngCopy = .Range("A7:AH" & LR)
        End With
        .Range("B8").Resize(rngCopy.Rows.Count, 2).Value = rngCopy.Columns("J:K").Value
        .Range("D8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("D").Value
        .Range("E8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("F").Value
        .Range("F8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("N").Value
        .Range("K8").Resize(rngCopy.Rows.Count, 2).Value = rngCopy.Columns("O:P").Value
        .Range("N8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("O").Value
        .Range("O8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("Y").Value
        .Range("P8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("Y").Value


            
        .Range("A8").Resize(rngCopy.Rows.Count).Value = "ABC Inc."
        


                
    End With
    
End Sub

 

[Fluff]

Cross posted https://www.excelforum.com/excel-programming-vba-macros/1276881-macro-to-copy-paste-data.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[bluepenink]

Hi Fluff

Oh of course, noted!

All, the sample file is attached in the link mentioned by Fluff. Im having some trouble trying to add logic so it only copy/paste when value <>"" or >0.

thx you

 

[Steve_]

essentially, i want the macro to copy/paste where there is a value > 0 or <>"" in column Y from the "data" tab.

[/QUOTE]

I have done my best to write code within that guideline. I am not sure I understand exactly what you are asking but i did try...

[CODE]
Sub Merge()
Dim rngCopy As Range, LR As Long
    With Sheets("OUT")
        'Clear old data
        If .Range("A8") <> Empty Then
            .Range("A8", .Range("A" & Rows.Count).End(xlUp)).EntireRow.ClearContents
        End If
        'Copy
        With Sheets("Data")
            LR = .Range("B" & Rows.Count).End(xlUp).Row
            If .Range("Y" & Rows.Count).End(xlUp).Row > 0 Or .Range("Y" & Rows.Count).End(xlUp).Row = "" Then
                Set rngCopy = .Range("A7:AH" & LR)
                didCopy = True
            End If
        End With
        If didCopy Then
            .Range("B8").Resize(rngCopy.Rows.Count, 2).Value = rngCopy.Columns("J:K").Value
            .Range("D8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("D").Value
            .Range("E8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("F").Value
            .Range("F8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("N").Value
            .Range("K8").Resize(rngCopy.Rows.Count, 2).Value = rngCopy.Columns("O:P").Value
            .Range("N8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("O").Value
            .Range("O8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("Y").Value
            .Range("P8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("Y").Value
            .Range("A8").Resize(rngCopy.Rows.Count).Value = "ABC Inc."
        End If
    End With
End Sub

 

[bluepenink]

I have done my best to write code within that guideline. I am not sure I understand exactly what you are asking but i did try...

Sub Merge()
Dim rngCopy As Range, LR As Long
    With Sheets("OUT")
        'Clear old data
        If .Range("A8") <> Empty Then
            .Range("A8", .Range("A" & Rows.Count).End(xlUp)).EntireRow.ClearContents
        End If
        'Copy
        With Sheets("Data")
            LR = .Range("B" & Rows.Count).End(xlUp).Row
            If .Range("Y" & Rows.Count).End(xlUp).Row > 0 Or .Range("Y" & Rows.Count).End(xlUp).Row = "" Then
                Set rngCopy = .Range("A7:AH" & LR)
                didCopy = True
            End If
        End With
        If didCopy Then
            .Range("B8").Resize(rngCopy.Rows.Count, 2).Value = rngCopy.Columns("J:K").Value
            .Range("D8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("D").Value
            .Range("E8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("F").Value
            .Range("F8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("N").Value
            .Range("K8").Resize(rngCopy.Rows.Count, 2).Value = rngCopy.Columns("O:P").Value
            .Range("N8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("O").Value
            .Range("O8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("Y").Value
            .Range("P8").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Columns("Y").Value
            .Range("A8").Resize(rngCopy.Rows.Count).Value = "ABC Inc."
        End If
    End With
End Sub

Hi steve

thanks for the reply.

doesnt seem like the macro you provided worked. Basically, if there is a value >0 or <>"" I want the macro to copy / paste the desired columns. In the above, there is a link to another form that has the document. Thoughts? thxs again!