VBA to cut and paste within one worksheet, and then replicating the action in multiple sheets of one workbook

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


Sample%20data.JPG
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

RudiS

Active Member
Joined
May 7, 2015
Messages
349
Hi,

Will there be more than two tables next to each other that need to be appended below each other? IOW: On sheets, could there be a third list from Q to X ?
 

RudiS

Active Member
Joined
May 7, 2015
Messages
349
Try this code...
It assumes there are only two lists in each sheet.

Code:
Sub AppendData()
Dim sh As Worksheet
Dim rS As Range
Dim lD As Long
    Application.ScreenUpdating = False
    For Each sh In Sheets
        If UCase(sh.Name) = "LAST" Then Exit For
        Set rS = Range(sh.Cells(1, "I"), sh.Cells(Rows.Count, "P").End(xlUp))
        lD = sh.Cells(Rows.Count, "A").End(xlUp).Offset(1).Row
        rS.Cut sh.Cells(lD, 1)
        sh.Cells(lD, 1).EntireRow.Delete
        On Error Resume Next
        sh.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
    Next sh
    Application.ScreenUpdating = True
End Sub
 

keenlearner

New Member
Joined
May 30, 2015
Messages
3
Hi,

Thank you for your help. It would only ever be two tables, yes, so what you have based the code on is fine. The code you have sent seems to do the trick from first tests, however it overwrites the headers in row 1, which ideally I would like to keep for the first table and remove/not copy across for the second table - are there any tweaks I can make to the formula to do this, please?

Thanks
 

RudiS

Active Member
Joined
May 7, 2015
Messages
349

ADVERTISEMENT

I have written the macro to preserve the first tables header row and remove the header of the second table when it adds it to te bottom of the first. In my tests simulating this data the macro runs perfectly across the sheets removing the titles from the second table only. I gathered that this should be the case, so I'm not sure why it is not working with your tables??
 

keenlearner

New Member
Joined
May 30, 2015
Messages
3
I've had a play and worked it out, I didn't have a title in A1 in my data, if i update the prior VBA to put a title in there the code you have provided does the job perfectly.

Thanks
 

Watch MrExcel Video

Forum statistics

Threads
1,130,119
Messages
5,640,219
Members
417,131
Latest member
Seanr19871

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top