asked on

Moving ranges of data values from one worksheet to another by macro

Hi, everybody!

I have an Excel spreadsheet where one sheet has a template with formulas for column totals and the like, and another sheet in the same workbook which contains raw data. I'd like to put a macro that could be triggered by a button to move the similar rows of data over to the template form.

For example, on the template form, every 3 rows represents one market segment (it's a P&L for a hotel company, and thus the segment has room sold, Avg. Daily Rate, and Rooms Revenue in 3 rows, then moves on to the next segment). Rooms revenue is a formula (rooms sold x avg. rate) and the raw data is imported via a data import onto a 2nd worksheet. I'd like to take the rooms sold & avg. daily rate data that's in the same relative positioning on the 2nd sheet and use the macro to move those values to the template sheet so that our forecasting teams can work with them. Any assistance you could provide would be most appreciated!

Best,
- doctornick0

nutsch

Load a template file with dummy data and it should be easy for one of the experts to help you out.

Thomas

doctornick0

ASKER

Dear Thomas,

Certainly. Please see the template file attached. What I'm trying to accomplish is move the values in the 1st 2 rows of the "OTBReport" sheet to the similar cells in the "31DayMonth" sheet, such that, for example, OTBReport!B24:AF25 would be able to be copied over to 31DayMont!B13:AF15. If the VBA is written with a loop inside, once I see how 2 ranges work with the syntax, I can just add the additional ranges to the loop with a little guidance.

Thanks for your help!
- doctornick0
Daily-Forecast-Template--Dummy-F.xlsx

nutsch

Try this:

Sub asgas()
Dim lLastRow As Long, lRowLoop As Long, rgLoop As Range
Dim rgOTB As Range, rgFound As Range
Dim shtDest As Worksheet, shtOrg As Worksheet

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

Set shtOrg = ActiveSheet
Set shtDest = Sheets("31DayMonth")

lLastRow = shtOrg.Cells(Rows.Count, 1).End(xlUp).Row

Set rgOTB = shtOrg.Range("A24:A" & lLastRow).SpecialCells(xlCellTypeConstants)

For Each rgLoop In rgOTB.Cells
    If InStr(rgLoop, ".") = 0 Then GoTo nxtRgLoop

    If IsNumeric(Left(rgLoop, InStr(rgLoop, ".") - 1)) Then
        
        Set rgFound = shtDest.Columns(1).Find(rgLoop.Value)
        
        If Not rgFound Is Nothing Then
            rgLoop.Offset(, 1).Resize(2, 31).Copy rgFound.Offset(, 1)
        End If
    
    End If

nxtRgLoop:
Next rgLoop
     
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With

End Sub

Open in new window

doctornick0

ASKER

Dear Thomas,

Thank you for the code. It didn't seem to move anything over. I can run this from the 31DayMonth sheet, correct?

Thanks for your help!
- doctornick0

ASKER CERTIFIED SOLUTION

nutsch

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

doctornick0

ASKER

Thank you so much for your help -- that worked perfectly!