Macro for moving data from worksheet to another but to the right dates

Eyeson15

Board Regular
Joined
Apr 30, 2015
Messages
201
Hello forum members,

I have a simple problem but I really really really need your assistance.

Before posting this new thread I have done extensive search on google for 'move column' 'move data' and couldn't find what I was looking for.

I have a workbook with 2 worksheets "Data" and "Ledger"

Every item in Data has a date and it needs to be moved to Ledger under the date specified.

Moving only column A:E into Ledger column A:E.

You will understand when you have a look so I attach screenshots.

I did the first three days manually to show what I am trying to achieve.

Any help will be greatly appreciated.

Regards,

James Leighon

2utt26p.jpg


1grbrd.jpg


2dkg487.jpg
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
3,809
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Try this:
I assume that in sheet Ledger the header with the font bold is already in there. Otherwise this macro won't work.
Code:
Sub a926234a()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long
Dim ry As Long
Dim sDate
Dim rz As Long
Application.ScreenUpdating = False

Application.CutCopyMode = False
Set ws1 = sheets("Data")
Set ws2 = sheets("Ledger")

With ws1

    sDate = .Cells(1, 1)
    For i = 1 To .Range("A" & Rows.count).End(xlUp).row
        
        ry = .Range("A:A").Find(sDate, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
        rz = ws2.Range("A:A").Find(sDate, SearchOrder:=xlByRows, SearchDirection:=xlNext).row + 1
        ws2.Range(ws2.Cells(rz, "A"), ws2.Cells(rz + ry - i, "E")).Value = _
        .Range(.Cells(i, "A"), .Cells(ry, "E")).Value
        sDate = .Cells(ry + 1, 1)
        i = ry
    Next i
End With
   
   Application.ScreenUpdating = True
   Application.CutCopyMode = True

End Sub
 

Eyeson15

Board Regular
Joined
Apr 30, 2015
Messages
201
Akuini

Thank you so so so much!

That works great. You have saved me from ALOT of work.

Can't thank you enough.

Cheers

James
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
3,809
Office Version
  1. 365
Platform
  1. Windows
You're welcome. Glad to help.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,167,650
Messages
5,854,940
Members
431,687
Latest member
anthonyj

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