Macro to copy and paste rows down to row above next entry

[yorkshirelad]

Hi - I hope someone can help me on this one, I need to do this exercise thousands of times!

I have a spreadsheet listing products. Each product has data in columns (columns A,B,C,D,E,F). Underneath each product are blank rows before the next product is listed.

I need a macro to copy Row1 columns A to F, and then paste the data in rows 2 to 5 (the next product on the list which is in Row6) - the macro then needs to continue that process until there are no products left.

The number of blank rows vary between each product, I have about six thousand products over about 20,000 lines

APOLOGIES I HAD FORMATTED THE TABLE BELOW TO LINE UP, BUT IT HASN'T WORKED.

Here is a link to a sample file if my description doesn't make sense.

http://www.creativepartnershosting.com/excel/CopyPasteDataSample.xls

Column A, Column B, Column C, Column D, Column E, Column F,
Row 1 45879645, DescrT, ColourJ, SizeIO, SupplierFE, TelephoneK,
BLANK ROWS
Row 6 45879122, DescrG, ColourR, SizeJ, SupplierW, TelephoneL,
BLANK ROWS
Row 9 58794512, DescrR, ColourH, SizeW, SupplierK, TelephoneP,
BLANK ROWS
Row 16 56987456, Descr16, Colour16, Size16, Supplier16, Telephone16,
BLANK ROWS
Row 19 54268747, Descr1G, ColourY, SizeP, SupplierS, TelephoneK,

Any assistance would be really appreciated.

Many thanks

 

[patel45]

It was possible directly with the previous macro I suggested you, You did not ask for that.

 

[yorkshirelad]

Thanks Patel - I could not have done it in that order. I had a lot of work with the data before extending it down. All the information was copied across but there was information missing and information in the wrong order on the string. Extending it down in the previous macro would have meant I had have multiple rows of wrong data rather than single ones.

I've now edited the data and it is ready to be copy and pasted down.

Many thanks for your reply

 

[JonesyUK]

fastest way to do this is:

1) Select All data, i.e. Range A3:F50 (in your example)
2) Use "Go to Special", and select "Blanks"
3) press "=" key, and then select the cell immediately above the active cell
4) hit control+Enter

Should now have filled all the blanks correctly.

 

[yorkshirelad]

Many thanks JonesyUK - Wow - I've never that before.

Only small challenge - I didn't think to mention it before but some of the data cells are empty. I there a way of selected just the blank rows?

Many thanks again

 

[JonesyUK]

This is a little trickier. I can only do this by adding an additional step. (Again - I'm using your sample data)

1) Enter this formula into Cell G3: "=COUNTBLANK(A3:F3)"
2) Copy this formula all the way down to the end of your data
3) The formula should say "6" for totally blank rows, or a lower number for rows that are partially empty
4) Change Column "G" to Values (Copy, Paste Special Values) - this will remove all the formulas
5) Select All data, i.e. Range A3:F50 (in your example)
6) Use "Go to Special", and select "Blanks"
3) press "=" key, and enter this formula: =IF($G4=6,A3,"")
4) hit control+Enter

Should now have filled all the blanks correctly, ignoring partially filled rows, i.e. with empty cells.

Worked for me, so let us know if you get stuck.

Thanks,

 

[yorkshirelad]

Many thanks to everyone who have replied but I got this answer from another source and it works a treat.

Again I really appreciate all the suggestions but this one was the neatest

Public Sub sub_Fill_AtoF_from_H()
Dim I As Integer
Dim J As Integer
Dim wName As String

I = 3 ' Beginning Row
wName = ActiveSheet.Name 'Can change to a specific spreadsheet name, helps reduce errors, also add workbook if planning on using multiple workbooks at the same time
While Len(Worksheets(wName).Cells(I, 8).Value) > 0 ' If Column H is blank, then will exit loop
If Worksheets(wName).Cells(I, 1).Value = "" Then ' If Column A is blank, then procede
For J = 1 To 6 ' Cycle columns A to F
Worksheets(wName).Cells(I, J).Value = Worksheets(wName).Cells(I - 1, J).Value ' Make each cell the value of the one above it
Next
End If
I = I + 1 ' Increase row Number
Wend
End Sub

 

[JonesyUK]

Thanks for sharing the solution that you received, very helpful.

You may want to download and install asap utilities which would have completed your task in 5 seconds.

ASAP Utilities - The essential add-in for Excel users. FREE excel tools and macros to save time. Download Excel tools - Excel software

It's free, and VERY useful.

All the Best.

 

[yorkshirelad]

Thanks for the tip on ASAP Utilities - I installed that a few years ago and have forgotten how useful it was. I'll download it again.

Best wishes