keenlearner
New Member
- Joined
- May 30, 2015
- Messages
- 3
When I run a report from a system I am provided with a workbook with a number of worksheets in it. The number of worksheets can vary depending on the parameters that the report is run under. I have used VBA to tidy up the report a bit but I am very much a novice and so am struggling with my next step.
So after tidying up the report already I would be left with a workbook with anything from two worksheets plus. The last worksheet has been renamed “Last” as I do not want anything to be done to this sheet. All worksheets but the “Last” worksheet are currently selected and rows 1-11 on the worksheets selected are highlighted/selected.
There are up to two lists of data on each worksheet, and what I want to do is cut the second list and paste it to appear underneath the first list. The lists are not always the same length, and there are sometimes blank rows in one or both of the lists, so a simple “ctrl + shft + down and right” won’t work.
Below is the formula I have been using, although this seems to work, when I have done some sanity checks it appears to be deleting some rows out on some of the sheets and I can’t work out why. I have tried to attach an image, but not sure it has worked, in the image it shows a sample of what one of the worksheets looks like, as you will see row 32 is blank for table 2 but there is still data underneath that i want to cut and move. It is the data in columns I-P that i want to paste underneath columns A-H. As mentioned, the table lengths differ from tab to tab, and sometimes there is nothing at all in columns I-P. I don't know if the starting position, with worksheets and rows highlighted as mentioned above, has anything to do with it...I just can't figure it out!!
Hopefully this is enough information, but please let me know if more is required or if i need to post this question elsewhere.
Can anyone help, please?
Sub copypaste()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Last" Then
For Each cell In ws.Range("J1")
If cell.Value = "" Then
Else
Range("I2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Range("A10000").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End If
Next ws
End Sub
So after tidying up the report already I would be left with a workbook with anything from two worksheets plus. The last worksheet has been renamed “Last” as I do not want anything to be done to this sheet. All worksheets but the “Last” worksheet are currently selected and rows 1-11 on the worksheets selected are highlighted/selected.
There are up to two lists of data on each worksheet, and what I want to do is cut the second list and paste it to appear underneath the first list. The lists are not always the same length, and there are sometimes blank rows in one or both of the lists, so a simple “ctrl + shft + down and right” won’t work.
Below is the formula I have been using, although this seems to work, when I have done some sanity checks it appears to be deleting some rows out on some of the sheets and I can’t work out why. I have tried to attach an image, but not sure it has worked, in the image it shows a sample of what one of the worksheets looks like, as you will see row 32 is blank for table 2 but there is still data underneath that i want to cut and move. It is the data in columns I-P that i want to paste underneath columns A-H. As mentioned, the table lengths differ from tab to tab, and sometimes there is nothing at all in columns I-P. I don't know if the starting position, with worksheets and rows highlighted as mentioned above, has anything to do with it...I just can't figure it out!!
Hopefully this is enough information, but please let me know if more is required or if i need to post this question elsewhere.
Can anyone help, please?
Sub copypaste()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Last" Then
For Each cell In ws.Range("J1")
If cell.Value = "" Then
Else
Range("I2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Range("A10000").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End If
Next ws
End Sub