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?
 
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

0
 
NorieVBA ExpertCommented:
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...?
0
 
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

0
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

 
NorieVBA ExpertCommented:
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

0
 
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
0
 
DarrenJacksonAuthor Commented:
Yes it is late I will look at both sets if code in the morning

Thank you both
0
 
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
0
 
NorieVBA ExpertCommented:
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

0
 
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

0
 
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

0
 
NorieVBA ExpertCommented:
Huh?
0
 
DarrenJacksonAuthor Commented:
Guys thanks for the extra input let me get back to you

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

Regards
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.