Loop Copy portions of rows to another sheet

[Mr_Ragweed2]

Hello and much thanks in advance. I'm trying to write a loop that searches a range of rows (19-31) and if there is data in column C for that row then i want t paste columns C:U from that row into another sheet. It's been a long time since i've done this and VBA is not part of my regular work - so apologies for simple errors.

[Code starts here]
Dim i As Integer
For i = 19 To 31 These are the only rows that could contain data. it may be zero rows or all of them.
ThisFinal = Cells(Rows.Count, 1).End(xlUp).Row

If Sheets("Dekalb Seed Order Form").Cells(i, 3).Value <> "" Then

Sheets("Form Sheet").Rows(i).Select -This is where i'm wrong. This selects the whole row and i just want columns C:U from each row with data.
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Selection.UnMerge (required due to huge formatting differences btwn the sheets)

Selection.Copy
Sheets("Order Summary").Select This is my attempt to paste it to the next available row on a different sheet
Cells(ThisFinal + 1, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("Form Sheet").Activate

End If

Next i
[end code]

(sorry about code tags being wrong)

 

[rlv01]

Can you clarify?

ThisFinal = Cells(Rows.Count, 1).End(xlUp).Row

Cells in what worksheet? Rows in what worksheet?

Cells(ThisFinal + 1, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Cells in what worksheet?

 

[Mr_Ragweed2]

My apologies. Copy rows from "Form Sheet" to "Order Summary"

 

[Mr_Ragweed2]

Sorry. I think i figured out what you were meaning. My finalrow statement did not reference any specific sheet. Here is my new code:

Dim RR As Range
Set RR = ActiveSheet.Range("C:U")

Dim i As Integer
For i = 19 To 31
ThisFinal = Sheets("Order Summary").Cells(Rows.Count, 1).End(xlUp).Row

    If Sheets("Dekalb Seed Order Form").Cells(i, 3).Value <> "" Then

Sheets("Dekalb Seed Order Form").Rows(i).Range(RR).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
      
    Selection.UnMerge
    
    Selection.Copy
    Sheets("Order Summary").Select
    Cells(ThisFinal + 1, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Dekalb Seed Order Form").Activate
    
    End If
    
Next i

I still cannot git it to just pull columns C:U instead of the whole row as a loop.
Thanks again for your interest and help.

 

[rlv01]

Sorry. I think i figured out what you were meaning. My finalrow statement did not reference any specific sheet. Here is my new code:

.
.
I still cannot git it to just pull columns C:U instead of the whole row as a loop.
Thanks again for your interest and help.

Your previous example referenced a 3rd worksheet named "Form Sheet"

            Sheets("Form Sheet").Rows(i).Select       '-This is where i'm wrong. This selects the whole row and i just want columns C:U from each row with data.

which as been eliminted in your new example. Is that intentional.

Also,

    Set RR = ActiveSheet.Range("C:U")

Which sheet is supposed to be ActiveSheet when the macro is run?

 

[rlv01]

Possibly something like this.

    Dim ThisFinal As Long
    Dim i As Integer
    Dim OSumWS As Worksheet
    Dim DekalbWS As Worksheet

    Set OSumWS = Sheets("Order Summary")
    Set DekalbWS = Sheets("Dekalb Seed Order Form")
    
    For i = 19 To 31
        ThisFinal = OSumWS.Cells(Rows.Count, 2).End(xlUp).Row

        If DekalbWS.Cells(i, 3).Value <> "" Then
            With Application.Intersect(DekalbWS.Rows(i).EntireRow, DekalbWS.Range("C:U"))
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .UnMerge
                .Copy
            End With

            OSumWS.Cells(ThisFinal + 1, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next i
    OSumWS.UsedRange.Columns.AutoFit

 

[Mr_Ragweed2]

Thank you.
Yes "Form Sheet" and "Dekalb Seed Order Sheet" are in fact the same sheet. Not sure why i changed the name when i posted my original code.

Which sheet is supposed to be ActiveSheet when the macro is run?

That was meant to be referencing the "OSumWS". This macro will actually run from a button/activexcontrol on the "DekalbWS".

I tried running the code and get an error "object required" on this line:

With Application.Intersect(DekalbWS.Rows(i).EntireRow, DekalbWS.Range("C:U"))

Again many thanks. I only do this about every 5-7 years, therefore i get really rusty and cross my wires on how to do things.

 

[rlv01]

I tried running the code and get an error "object required" on this line:

Are you sure did not change anything? Try this version.

    Dim ThisFinal As Long
    Dim i As Integer
    Dim OSumWS As Worksheet
    Dim DekalbWS As Worksheet
    Dim rng As Range

    On Error Resume Next
    Set OSumWS = Sheets("Order Summary")
    Set DekalbWS = Sheets("Dekalb Seed Order Form")
    On Error GoTo 0

    If OSumWS Is Nothing Then
        MsgBox "Worksheet 'Order Summary' is missing. " & vbCrLf & "", vbOKOnly Or vbCritical, Application.Name
        Exit Sub
    End If
    
    If DekalbWS Is Nothing Then
        MsgBox "Worksheet 'Dekalb Seed Order Form' is missing. " & vbCrLf & "", vbOKOnly Or vbCritical, Application.Name
        Exit Sub
    End If

    For i = 19 To 31
        Set rng = Nothing
        ThisFinal = OSumWS.Cells(Rows.Count, 2).End(xlUp).Row

        If DekalbWS.Cells(i, 3).Value <> "" Then
            On Error Resume Next
            Set rng = Application.Intersect(DekalbWS.Rows(i).EntireRow, DekalbWS.Range("C:U"))
            On Error GoTo 0

            If Not rng Is Nothing Then
                With rng
                    .HorizontalAlignment = xlGeneral
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = False
                    .UnMerge
                    .Copy
                End With
                OSumWS.Cells(ThisFinal + 1, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Else
                Debug.Print "Nothing to copy"
            End If
        End If
    Next i
    OSumWS.UsedRange.Columns.AutoFit

 

[Mr_Ragweed2]

Thank you rlv01. I removed the error handlers as i knew the sheets weren't missing and the code seems to work (I must of had a typo the first time). However it is pulling 2 extra lines and adding a few zeros. (see below)
I even cleared the contents of those cells and re-ran it to be sure. The sheet you see below is "OSumWS".

 

[rlv01]

However it is pulling 2 extra lines and adding a few zeros. (see below)
I even cleared the contents of those cells and re-ran it to be sure. The sheet you see below is "OSumWS".
View attachment 78654

It is just processing the row range you defined. Either adjust this For i = 19 To 31 to this For i = 19 To 29. Or else make sure that
DekalbWS.Cells(i, 3).Value <> "" in If DekalbWS.Cells(i, 3).Value <> "" Then does not evaluate to TRUE for the lines you do not want to include.