copy multiple rows to new single row sequentially in new worksheet

jetpack

Board Regular
Joined
Nov 4, 2010
Messages
81
excel 2016

I have 40+ columns of data in 100s of rows.

At a specified time each day I need to copy each row sequentially to a single row in a new worksheet.

As an example:

DataSheet is the sheet from which data should be copied. NewSheet is the receiving sheet.

Process would be as follows;

copy DataSheet A1:A40 to NewSheet A1 and add 1 blank column at end.
copy DataSheet B1:B40 to NewSheet A42 and add 1 blank column at end.
copy DataSheet C1:C40 to NewSheet A:84 and add 1 blamk column at end.
copy DataSheet D1:D40 to NewSheet A:125 and add 1 blank column at end.
Continue to end of rows.

# of columns and rows may change from day to day, but will always be the same # of each on any particular sheet. NewSheet would be named according to date procedure is ran, ie; 1_23_18 for Jan 23 2018.

Seems like a combination of loops and count(), but beyond my ability to construct anything that works.

Appreciate everyone who takes the time to read this post!
 
Well I think you already have another script that works.
But try this:
I took out the error checking.
You do realize the sheet name is todays Date not Date and Time like other post I see here.
If it errors out now tell me what line it errors out on.
Code:
Sub Copy_My_Data()
'Modified  12/2/2018  6:56:14 PM  EST
Application.ScreenUpdating = False
'On Error GoTo M
Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastcc As Long
Dim LastColumn As Long
Sheets.Add(After:=Sheets(Sheets.Count)).Name = Format(Date, "mmm dd yyyy")
ans = ActiveSheet.Name
Sheets(1).Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
LastColumn = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
    
For i = 1 To Lastrow
    Sheets(1).Cells(i, 1).Resize(, LastColumn).Copy
        Lastcc = Sheets(ans).Cells(2, Columns.Count).End(xlToLeft).Column + 2
            If i < 2 Then Lastcc = 1
        Sheets(ans).Cells(2, Lastcc).PasteSpecial xlPasteValues
Next
   
Application.CutCopyMode = False
Application.ScreenUpdating = True
Exit Sub
'M:
'MsgBox "The sheet named  " & Date & " Already exist. I have stopped the script"

End Sub
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
ok, ran new macro.

empty sheet created, but stops at Sheets(ans).Cells(2, Lastcc).PasteSpecial xlPasteValues with error 1004

Does that info help?
 
Upvote 0
Well you already have a script that works so is the one from the other user not working?
I have tested this script 20 or more times and it works for me.
 
Upvote 0
yes, the other macro is working fine.

based on your prior comments, I thought informing you of a problem was a courtesy to you so that you could learn where a problem exists in your code. maybe I misunderstood what you meant?

no worries. mate. truly appreciate your willingness to help and the time you have spent on this request. thanks again.
 
Upvote 0
Are you saying my script worked all along and it was just the fact that you had never shut down Excel and restarted Excel.
I thought we had been talking about this over about 3 days. You surely do not keep Excel Open for days at a time without closing down Excel do you.

I normally Exit Excel at least every hour and restart Excel. And completely shut down my computer and restart at least twice a day.

Well I hope you have what you need now. Glad I was helpful.
Next time please say Row(2) not Row(B) Take care of yourself Mate.
I guess Mate is a
Australian[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] term.[/FONT]
How is the weather down there?


as a lark. I shut down excel and restarted it, all's *******s now mate. thanks again.
 
Upvote 0
ha!

no worries mate. excel is known for carking it, but during the workday not possible to shut the joey down every hour. couldn't use it if that was necessary, fair dinkum.

as for testing, not that daft to give it a go without snuffing it out, just hadn't done so with the last run of your code. gud onya for the last verz, tho.

yea, she be hotter 'n a troppo.
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

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
Back
Top