?
Solved

copy macro to copy from 1 sheet to another

Posted on 2011-10-03
13
Medium Priority
?
240 Views
Last Modified: 2012-05-12
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
0
Comment
Question by:DarrenJackson
  • 5
  • 4
  • 4
13 Comments
 
LVL 35

Expert Comment

by:Norie
ID: 36907028
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
 
LVL 8

Expert Comment

by:wchh
ID: 36907058
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
 
LVL 35

Expert Comment

by:Norie
ID: 36907064
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:DarrenJackson
ID: 36907075
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
 

Author Comment

by:DarrenJackson
ID: 36907080
Yes it is late I will look at both sets if code in the morning

Thank you both
0
 

Author Comment

by:DarrenJackson
ID: 36908879
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
 
LVL 35

Assisted Solution

by:Norie
Norie earned 1000 total points
ID: 36909564
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
 
LVL 8

Expert Comment

by:wchh
ID: 36913817
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
 
LVL 8

Accepted Solution

by:
wchh earned 1000 total points
ID: 36913827
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
 
LVL 8

Expert Comment

by:wchh
ID: 36913845
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
 
LVL 35

Expert Comment

by:Norie
ID: 36915619
Huh?
0
 

Author Comment

by:DarrenJackson
ID: 36915629
Guys thanks for the extra input let me get back to you

Many Thanks
0
 

Author Comment

by:DarrenJackson
ID: 36917881
Guys thanks for the input I will split points

Regards
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
New style of hardware planning for Microsoft Exchange server.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

864 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question