Answered by:
VBA copy until blank and copy again until next blank then paste
Question

Can anyone help me out with the following VBA script? I am trying to copy the first row until blank column and then go down to the next filled row, etc. then paste in a table. The following is the data: Ideally it would Copy B1:F1 then stop Paste in B30:F30, then skip blank rows and copy row B10:f10 and B11:f10 then Paste in B31:F30, then copy B20:F30, B21:F21, B22:F22 and then Paste B32:F32? It could also copy then paste after all copies if easier. The data will always change in the number of items in each set of 9 rows depending on the input so a macro record will not work properly. Also, ideally it would sort alphabetically and remove duplicates but I can record second macro to sort and remove duplicates. Any help is appreciated. Thanks!
A B C D E F 1 Apples Apples Apples Apples Apples 2 3 4 5 6 7 8 9 10 Oranges Oranges Oranges Oranges Oranges 11 Apples Apples Apples Apples Apples 12 13 14 15 16 17 18 19 20 Plumbs Plumbs Plumbs Plumbs Plumbs 21 Oranges Oranges Oranges Oranges Oranges 22 Apples Apples Apples Apples Apples 30 Apples Apples Apples Apples Apples 31 Oranges Oranges Oranges Oranges Oranges 32 Plumbs Plumbs Plumbs Plumbs Plumbs
Answers

Still not sure how you want it sorted based on actual values..... but try this.
Sub Test3()
Dim R As Range
Set R = Range("A1").CurrentRegion
R.Copy Range("A30")
Set R = R(R.Rows.Count, 1).End(xlDown).CurrentRegion
R.Copy Range("A30").Offset(Range("A30").CurrentRegion.Rows.Count)
Set R = R(R.Rows.Count, 1).End(xlDown).CurrentRegion
R.Copy Range("A30").Offset(Range("A30").CurrentRegion.Rows.Count)
End Sub
 Edited by Bernie Deitrick, Excel MVP 20002010 Friday, November 6, 2015 12:24 AM
 Proposed as answer by Starian chenMicrosoft contingent staff, Moderator Friday, November 6, 2015 3:35 AM
 Marked as answer by Fei XueMicrosoft employee, Moderator Thursday, November 19, 2015 2:12 AM
All replies

This will create the unsorted list  not sure if your values are really all the same in every row....
Sub Test()
Dim R As Range
Set R = Range("A1")
Range(R, R.End(xlToRight)).Copy R.End(xlDown)(2)
Set R = R.End(xlDown)
Range(R, R.End(xlToRight)(2)).Copy R(2).End(xlDown)(2)
Set R = R(2).End(xlDown)
Range(R, R.End(xlToRight)(3)).Copy Range("A30")End Sub
Or just create it at the final place
Sub Test2()
Dim R As Range
Set R = Range("A1")
Range(R, R.End(xlToRight)).Copy Range("A30")
Set R = R.End(xlDown)
Range(R, R.End(xlToRight)).Copy Range("A31")
Set R = R.End(xlDown)
Range(R, R.End(xlToRight)).Copy Range("A32")
End Sub

Thanks. It doesn't quit work if more rows of fruit are added. For example adding bananas to row 2 or in A2. It now leaves off Plumbs from the list starting on row A30. Also, there should be blanks between rows of fruit. I tried to include the excel rows and columns numbering but hopefully didn't cause confusion. The script needs to be dynamic depending on the number of rows that are added in any section and then show up on the table starting on A30. It seems a do loop or for next loop is needed. If a bananas row and cherries row are added to A2 and A3, respectively, then starting on row A30 would show Apples, A31 Bananas, A32 Cherries, A33 Oranges, and A34 Plumbs. Thanks.

Still not sure how you want it sorted based on actual values..... but try this.
Sub Test3()
Dim R As Range
Set R = Range("A1").CurrentRegion
R.Copy Range("A30")
Set R = R(R.Rows.Count, 1).End(xlDown).CurrentRegion
R.Copy Range("A30").Offset(Range("A30").CurrentRegion.Rows.Count)
Set R = R(R.Rows.Count, 1).End(xlDown).CurrentRegion
R.Copy Range("A30").Offset(Range("A30").CurrentRegion.Rows.Count)
End Sub
 Edited by Bernie Deitrick, Excel MVP 20002010 Friday, November 6, 2015 12:24 AM
 Proposed as answer by Starian chenMicrosoft contingent staff, Moderator Friday, November 6, 2015 3:35 AM
 Marked as answer by Fei XueMicrosoft employee, Moderator Thursday, November 19, 2015 2:12 AM

Ok. Works great! Thanks! The code provided works with a macro to eliminate duplicates.
One more wrinkle, is it possible to write the code where it skips rows with blanks even through there are formulas within the cells/rows? Example row 2 might be visibly blank or even show zeros but they have formulas and they get copied as blanks to the table starting on A30. This causes a problem since the actual spreadsheet will encompass hundreds of rows to copy and even more blank rows and each spreadsheet will be different based on the data.

In that case, the best solution is to insert a column of formulas that displays either of two values, based on the status of the data, which can be used to filter the source and hide values that should not be copied. The formula required would be of the form
=IF(some condition or conditions,"Copy","Hide")
and then the macro would insert the column, insert the formulas, hide the rows with "Hide" and copy all the rest. The key is finding the correct formula.