Macro for copying not specific columns

[bizzarofen]

Hi, I had created a macro is looping for some values in one sheet and then copy valid rows to other sheets. However, I would like to amend macro only to copy entire rows to selected column, like A-I. Is there any way to do that? Pasting my macro below:

Sub CopyRows()

Dim bottomL As Long
Dim x As Long

    
bottomL = Sheets("Sales").Range("h" & Rows.Count).End(xlUp).Row: x = 1
     
 Dim c As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculateManual
    
    
    For Each c In Sheets("Sales").Range("h2:h" & bottomL)
        If c.Value = "89" Then
             c.EntireRow.Copy Worksheets("RL").Range("A" & x)
            x = x + 1
        End If
    Next c
    
    bottomL = Sheets("Sales").Range("h" & Rows.Count).End(xlUp).Row: x = 1
    For Each c In Sheets("Sales").Range("h2:h" & bottomL)
        If c.Value = "31" Then
            c.EntireRow.Copy Worksheets("OC").Range("A" & x)
            x = x + 1
        End If
    Next c

End Sub

Many thanks for help.

[Sintek]

Hi bizzarofen

What range do you want to copy to Range("A:I")...Not sure to copy entire row to only 9 columns

[bizzarofen]

Hello sintek,

I would like the macro to copy the values from column A:I to separate sheet instead of copying an entire row as I have some formulas in column J, which I would like to preserve.

[Sintek]

yes, but to what range in other worksheet must it copy to

[Sintek]

Something like this:

Sheet1.Range("A1:I1").Copy Sheet2.Range("A1:I1")

Sheet1.Range("A1:A3").Copy Sheet2.Range("D1")

[bizzarofen]

For instance if the value in column C in sheets Sales is 89, the macro should copy values from columns A:I into the tab's RL columns A:I, similarly to what you have just provided. Many thanks for your help.

[Sintek]

If Sheets("Sales").Range("C2") = "89" Then
   Sheets("Sales").Range("A2:I2") .Copy Sheets("RL").Range("A2")
End If

[bizzarofen]

That's precisely what I tried to do. Is there just a way to nest it into the loop:

For Each c In Sheets("Sales").Range("h2:h" & bottomL)
        If c.Value = "89" Then
             c.EntireRow.Copy Worksheets("RL").Range("A" & x)
            x = x + 1
        End If
    Next c

Rather than use fixed cells?

[Sintek]

Try this adaptation to your code:

Option Explicit
Sub CopyRows()
Dim lRow As Long, RLnRow As Long, OCnRow As Long, x As Long
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Application.ScreenUpdating = False

Set ws1 = Sheets("Sales")
Set ws2 = Sheets("RL")
Set ws3 = Sheets("OC")
lRow = ws1.Range("A" & Rows.Count).End(xlUp).Row


With ws1
    For x = 1 To lRow 'Change 1 to the row no your data starts in Sheets("sales")
        RLnRow = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
        OCnRow = ws3.Range("A" & Rows.Count).End(xlUp).Row + 1
        If .Range("C" & x) = "89" Then 'Change C to the column your value of 89 is in
            .Range("A" & x & ":I" & x).Copy ws2.Range("A" & RLnRow)
        ElseIf Range("C" & x) = "31" Then 'Change C to the column your value of 39 is in
            .Range("A" & x & ":I" & x).Copy ws3.Range("A" & OCnRow)
        End If
    Next x
End With

Application.ScreenUpdating = True
End Sub

[Sintek]

That's precisely what I tried to do.

Your code is using entirerow.copy

[bizzarofen]

Thank you sintek, it worked like a charm.

[Sintek]

Glad I could help....Please feel free to add to Reputation...thanks

[bizzarofen]

Just one last thing - it seems that the macro is copying values for RL sheets only without tab OC. Wonder what might be causing that.

[Sintek]

What do you mean...it only copies to Tab OC if value = 31....Can you upload a sample workbook

[bizzarofen]

I am so sorry, must've made some manual mistake, macro is working flawlessly. Much appreciated.

[Sintek]

macro is working flawlessly.

Do i deserve a rep point