copy macro to copy from 1 sheet to another

Guys I ve had help from EE on this already but I am after a small change which wasnt forseen before.

The attached excel sheet copies info from 1 sheet to another sheet see vb in attached file
The problem is that it aonly copies the 1 row plus the header info I am after the header and all rows copying that have data in column C on the Pricing Sheet

so the header info plus every row from C13 down over to C29 but there is rows 19 to 23 that need to be ignored.

The header info is replicated each time for the rows

Hope this makes sense

Regards
EE-Sample1.xlsm
DarrenJacksonAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
Darren

I must be missing something but the code doesn't seem to copy from C13 down.

It copies the header then B13, C13, E13, F13, G13 on each iteration of the loop.

The destination is moving down but not the source.

Do you want the 13 above to change to 14, 15... 18, skip to 24, 25, 26...?
wchhCommented:
Try macro amended below
Sub CopyForm(MyForm)

    x = 2

MyLoop:
    x = x + 1
    If Sheets("MEASURE").Range("A" & x).Value = "" Then
        Sheets("MEASURE").Range("A" & x).Value = Sheets(MyForm).Range("W1").Value 'No
        Sheets("MEASURE").Range("B" & x).Value = Sheets(MyForm).Range("B13").Value 'Item
        Sheets("MEASURE").Range("C" & x).Value = Sheets(MyForm).Range("B4").Value 'WOC NO
        Sheets("MEASURE").Range("D" & x).Value = Sheets(MyForm).Range("G4").Value 'Action Description
        Sheets("MEASURE").Range("E" & x).Value = Sheets(MyForm).Range("B7").Value 'Department
        Sheets("MEASURE").Range("F" & x).Value = Sheets(MyForm).Range("G7").Value 'Plant Item
        Sheets("MEASURE").Range("G" & x).Value = Sheets(MyForm).Range("K7").Value 'Sub System
        Sheets("MEASURE").Range("H" & x).Value = Sheets(MyForm).Range("C13").Value 'Scaff Tag Nr
        Sheets("MEASURE").Range("I" & x).Value = Sheets(MyForm).Range("E13").Value 'Out of Hours Working
        Sheets("MEASURE").Range("J" & x).Value = Sheets(MyForm).Range("F13").Value 'ELEVATION ?MTR
        Sheets("MEASURE").Range("K" & x).Value = Sheets(MyForm).Range("G13").Value 'STAR +% TO RATES
        '<--begin of insert
        For i = 14 To 29
            If i < 19 Or i > 23 Then
               If Sheets(MyForm).Range("C" & i).Value <> "" Then
                    x = x + 1
                    Sheets("MEASURE").Range("A" & x).Value = Sheets(MyForm).Range("W1").Value 'No
                    Sheets("MEASURE").Range("B" & x).Value = Sheets(MyForm).Range("B13").Value 'Item
                    Sheets("MEASURE").Range("C" & x).Value = Sheets(MyForm).Range("B4").Value 'WOC NO
                    Sheets("MEASURE").Range("D" & x).Value = Sheets(MyForm).Range("G4").Value 'Action Description
                    Sheets("MEASURE").Range("E" & x).Value = Sheets(MyForm).Range("B7").Value 'Department
                    Sheets("MEASURE").Range("F" & x).Value = Sheets(MyForm).Range("G7").Value 'Plant Item
                    Sheets("MEASURE").Range("G" & x).Value = Sheets(MyForm).Range("K7").Value 'Sub System
                    Sheets("MEASURE").Range("H" & x).Value = Sheets(MyForm).Range("C" & i).Value 'Scaff Tag Nr
                    Sheets("MEASURE").Range("I" & x).Value = Sheets(MyForm).Range("E" & i).Value 'Out of Hours Working
                    Sheets("MEASURE").Range("J" & x).Value = Sheets(MyForm).Range("F" & i).Value 'ELEVATION ?MTR
                    Sheets("MEASURE").Range("K" & x).Value = Sheets(MyForm).Range("G" & i).Value 'STAR +% TO RATES
               End If
            End If
        Next i
        '<--end of insert
        Sheets(MyForm).Select
        Range("A1").Select
    Else
        GoTo MyLoop
    End If
End Sub

Open in new window

NorieAnalyst Assistant Commented:
Try this, apologies if there's any mistakes - bit late.
Sub CopyForm(MyForm)

Dim X As Long
Dim I As Long



    X = 3
    For I = 13 To 29


        If I < 19 Or I > 23 Then

            If Sheets(MyForm).Range("C" & I).Value <> "" Then
                Sheets("MEASURE").Range("A" & X).Value = Sheets(MyForm).Range("W1").Value    'No
                Sheets("MEASURE").Range("B" & X).Value = Sheets(MyForm).Range("B" & I).Value    'Item
                Sheets("MEASURE").Range("C" & X).Value = Sheets(MyForm).Range("B4").Value    'WOC NO
                Sheets("MEASURE").Range("D" & X).Value = Sheets(MyForm).Range("G4").Value    'Action Description
                Sheets("MEASURE").Range("E" & X).Value = Sheets(MyForm).Range("B7").Value    'Department
                Sheets("MEASURE").Range("F" & X).Value = Sheets(MyForm).Range("G7").Value    'Plant Item
                Sheets("MEASURE").Range("G" & X).Value = Sheets(MyForm).Range("K7").Value    'Sub System
                Sheets("MEASURE").Range("H" & X).Value = Sheets(MyForm).Range("C" & I).Value    'Scaff Tag Nr
                Sheets("MEASURE").Range("I" & X).Value = Sheets(MyForm).Range("E" & I).Value    'Out of Hours Working
                Sheets("MEASURE").Range("J" & X).Value = Sheets(MyForm).Range("F" & I).Value    'ELEVATION ?MTR
                Sheets("MEASURE").Range("K" & X).Value = Sheets(MyForm).Range("G" & I).Value    'STAR +% TO RATES
            End If

            X = X + 1

        End If

    Next I

End Sub

Open in new window

IT Pros Agree: AI and Machine Learning Key

We’d all like to think our company’s data is well protected, but when you ask IT professionals they admit the data probably is not as safe as it could be.

DarrenJacksonAuthor Commented:
Imnorie

Yes as you noticed the header will always be a header but the source rows are filling down but the code doesn't do this so the code needs to move down and copy over to the destination but always repeating the header as well in the destination

Regards
DarrenJacksonAuthor Commented:
Yes it is late I will look at both sets if code in the morning

Thank you both
DarrenJacksonAuthor Commented:
Thanks guys for posting.

imnorie yours code when ran just replaces the destination I need it to append I think thats my bad sorry about that

wchh  your code is almost spot on i have 1 comment in that if say there is no data in the rows 13:18 when the code is ran it still places a line but with blank info in for the contents of column C in the destination sheet.

Can this be corrected??

Regards
NorieAnalyst Assistant Commented:
So x should start at the next available row on the destination sheet?
Sub CopyForm(MyForm)

Dim X As Long
Dim I As Long


    ' Find next empty row to put data
    X = Sheets("MEASURE").Range("A" & Rows.Count).End(xlUp).Row + 1
    
    For I = 13 To 29


        If I < 19 Or I > 23 Then

            If Sheets(MyForm).Range("C" & I).Value <> "" Then
                Sheets("MEASURE").Range("A" & X).Value = Sheets(MyForm).Range("W1").Value    'No
                Sheets("MEASURE").Range("B" & X).Value = Sheets(MyForm).Range("B" & I).Value    'Item
                Sheets("MEASURE").Range("C" & X).Value = Sheets(MyForm).Range("B4").Value    'WOC NO
                Sheets("MEASURE").Range("D" & X).Value = Sheets(MyForm).Range("G4").Value    'Action Description
                Sheets("MEASURE").Range("E" & X).Value = Sheets(MyForm).Range("B7").Value    'Department
                Sheets("MEASURE").Range("F" & X).Value = Sheets(MyForm).Range("G7").Value    'Plant Item
                Sheets("MEASURE").Range("G" & X).Value = Sheets(MyForm).Range("K7").Value    'Sub System
                Sheets("MEASURE").Range("H" & X).Value = Sheets(MyForm).Range("C" & I).Value    'Scaff Tag Nr
                Sheets("MEASURE").Range("I" & X).Value = Sheets(MyForm).Range("E" & I).Value    'Out of Hours Working
                Sheets("MEASURE").Range("J" & X).Value = Sheets(MyForm).Range("F" & I).Value    'ELEVATION ?MTR
                Sheets("MEASURE").Range("K" & X).Value = Sheets(MyForm).Range("G" & I).Value    'STAR +% TO RATES
            End If

            X = X + 1

        End If

    Next I

End Sub

Open in new window

wchhCommented:
Please refer to amended macro as below
Sub CopyForm(MyForm)

    x = 2

MyLoop:
    x = x + 1
    If Sheets("MEASURE").Range("A" & x).Value = "" Then
        '<--Begin of Comment
        'Sheets("MEASURE").Range("A" & x).Value = Sheets(MyForm).Range("W1").Value 'No
        'Sheets("MEASURE").Range("B" & x).Value = Sheets(MyForm).Range("B13").Value 'Item
        'Sheets("MEASURE").Range("C" & x).Value = Sheets(MyForm).Range("B4").Value 'WOC NO
        'Sheets("MEASURE").Range("D" & x).Value = Sheets(MyForm).Range("G4").Value 'Action Description
        'Sheets("MEASURE").Range("E" & x).Value = Sheets(MyForm).Range("B7").Value 'Department
        'Sheets("MEASURE").Range("F" & x).Value = Sheets(MyForm).Range("G7").Value 'Plant Item
        'Sheets("MEASURE").Range("G" & x).Value = Sheets(MyForm).Range("K7").Value 'Sub System
        'Sheets("MEASURE").Range("H" & x).Value = Sheets(MyForm).Range("C13").Value 'Scaff Tag Nr
        'Sheets("MEASURE").Range("I" & x).Value = Sheets(MyForm).Range("E13").Value 'Out of Hours Working
        'Sheets("MEASURE").Range("J" & x).Value = Sheets(MyForm).Range("F13").Value 'ELEVATION ?MTR
        'Sheets("MEASURE").Range("K" & x).Value = Sheets(MyForm).Range("G13").Value 'STAR +% TO RATES
        '<--End of Comment
        '<--begin of insert
        For i = 13 To 29
            If i < 19 Or i > 23 Then
               If Sheets(MyForm).Range("C" & i).Value <> "" Then
                    x = x + 1
                    Sheets("MEASURE").Range("A" & x).Value = Sheets(MyForm).Range("W1").Value 'No
                    Sheets("MEASURE").Range("B" & x).Value = Sheets(MyForm).Range("B13").Value 'Item
                    Sheets("MEASURE").Range("C" & x).Value = Sheets(MyForm).Range("B4").Value 'WOC NO
                    Sheets("MEASURE").Range("D" & x).Value = Sheets(MyForm).Range("G4").Value 'Action Description
                    Sheets("MEASURE").Range("E" & x).Value = Sheets(MyForm).Range("B7").Value 'Department
                    Sheets("MEASURE").Range("F" & x).Value = Sheets(MyForm).Range("G7").Value 'Plant Item
                    Sheets("MEASURE").Range("G" & x).Value = Sheets(MyForm).Range("K7").Value 'Sub System
                    Sheets("MEASURE").Range("H" & x).Value = Sheets(MyForm).Range("C" & i).Value 'Scaff Tag Nr
                    Sheets("MEASURE").Range("I" & x).Value = Sheets(MyForm).Range("E" & i).Value 'Out of Hours Working
                    Sheets("MEASURE").Range("J" & x).Value = Sheets(MyForm).Range("F" & i).Value 'ELEVATION ?MTR
                    Sheets("MEASURE").Range("K" & x).Value = Sheets(MyForm).Range("G" & i).Value 'STAR +% TO RATES
               End If
            End If
        Next i
        '<--end of insert
        Sheets(MyForm).Select
        Range("A1").Select
    Else
        GoTo MyLoop
    End If
End Sub

Open in new window

wchhCommented:
Please ignore previous message
Sub CopyForm(MyForm)

    x = 2

MyLoop:
    x = x + 1
    If Sheets("MEASURE").Range("A" & x).Value = "" Then
        '<--Begin of Comment
        'Sheets("MEASURE").Range("A" & x).Value = Sheets(MyForm).Range("W1").Value 'No
        'Sheets("MEASURE").Range("B" & x).Value = Sheets(MyForm).Range("B13").Value 'Item
        'Sheets("MEASURE").Range("C" & x).Value = Sheets(MyForm).Range("B4").Value 'WOC NO
        'Sheets("MEASURE").Range("D" & x).Value = Sheets(MyForm).Range("G4").Value 'Action Description
        'Sheets("MEASURE").Range("E" & x).Value = Sheets(MyForm).Range("B7").Value 'Department
        'Sheets("MEASURE").Range("F" & x).Value = Sheets(MyForm).Range("G7").Value 'Plant Item
        'Sheets("MEASURE").Range("G" & x).Value = Sheets(MyForm).Range("K7").Value 'Sub System
        'Sheets("MEASURE").Range("H" & x).Value = Sheets(MyForm).Range("C13").Value 'Scaff Tag Nr
        'Sheets("MEASURE").Range("I" & x).Value = Sheets(MyForm).Range("E13").Value 'Out of Hours Working
        'Sheets("MEASURE").Range("J" & x).Value = Sheets(MyForm).Range("F13").Value 'ELEVATION ?MTR
        'Sheets("MEASURE").Range("K" & x).Value = Sheets(MyForm).Range("G13").Value 'STAR +% TO RATES
        '<--End of Comment
        '<--begin of insert
        For i = 13 To 29
            If i < 19 Or i > 23 Then
               If Sheets(MyForm).Range("C" & i).Value <> "" Then
                    Sheets("MEASURE").Range("A" & x).Value = Sheets(MyForm).Range("W1").Value 'No
                    Sheets("MEASURE").Range("B" & x).Value = Sheets(MyForm).Range("B13").Value 'Item
                    Sheets("MEASURE").Range("C" & x).Value = Sheets(MyForm).Range("B4").Value 'WOC NO
                    Sheets("MEASURE").Range("D" & x).Value = Sheets(MyForm).Range("G4").Value 'Action Description
                    Sheets("MEASURE").Range("E" & x).Value = Sheets(MyForm).Range("B7").Value 'Department
                    Sheets("MEASURE").Range("F" & x).Value = Sheets(MyForm).Range("G7").Value 'Plant Item
                    Sheets("MEASURE").Range("G" & x).Value = Sheets(MyForm).Range("K7").Value 'Sub System
                    Sheets("MEASURE").Range("H" & x).Value = Sheets(MyForm).Range("C" & i).Value 'Scaff Tag Nr
                    Sheets("MEASURE").Range("I" & x).Value = Sheets(MyForm).Range("E" & i).Value 'Out of Hours Working
                    Sheets("MEASURE").Range("J" & x).Value = Sheets(MyForm).Range("F" & i).Value 'ELEVATION ?MTR
                    Sheets("MEASURE").Range("K" & x).Value = Sheets(MyForm).Range("G" & i).Value 'STAR +% TO RATES
                    x = x + 1
               End If
            End If
        Next i
        '<--end of insert
        Sheets(MyForm).Select
        Range("A1").Select
    Else
        GoTo MyLoop
    End If
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
wchhCommented:
imnorie code can be improved as below...
Sub CopyForm(MyForm)

Dim X As Long
Dim I As Long


    ' Find next empty row to put data
    X = Sheets("MEASURE").Range("A" & Rows.Count).End(xlUp).Row + 1
    
    For I = 13 To 29


        If I < 19 Or I > 23 Then

            If Sheets(MyForm).Range("C" & I).Value <> "" Then
                Sheets("MEASURE").Range("A" & X).Value = Sheets(MyForm).Range("W1").Value    'No
                Sheets("MEASURE").Range("B" & X).Value = Sheets(MyForm).Range("B" & I).Value    'Item
                Sheets("MEASURE").Range("C" & X).Value = Sheets(MyForm).Range("B4").Value    'WOC NO
                Sheets("MEASURE").Range("D" & X).Value = Sheets(MyForm).Range("G4").Value    'Action Description
                Sheets("MEASURE").Range("E" & X).Value = Sheets(MyForm).Range("B7").Value    'Department
                Sheets("MEASURE").Range("F" & X).Value = Sheets(MyForm).Range("G7").Value    'Plant Item
                Sheets("MEASURE").Range("G" & X).Value = Sheets(MyForm).Range("K7").Value    'Sub System
                Sheets("MEASURE").Range("H" & X).Value = Sheets(MyForm).Range("C" & I).Value    'Scaff Tag Nr
                Sheets("MEASURE").Range("I" & X).Value = Sheets(MyForm).Range("E" & I).Value    'Out of Hours Working
                Sheets("MEASURE").Range("J" & X).Value = Sheets(MyForm).Range("F" & I).Value    'ELEVATION ?MTR
                Sheets("MEASURE").Range("K" & X).Value = Sheets(MyForm).Range("G" & I).Value    'STAR +% TO RATES
                X = X + 1 '<--amended
            End If
            'X = X + 1 
        End If
    Next I

End Sub

Open in new window

NorieAnalyst Assistant Commented:
Huh?
DarrenJacksonAuthor Commented:
Guys thanks for the extra input let me get back to you

Many Thanks
DarrenJacksonAuthor Commented:
Guys thanks for the input I will split points

Regards
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.