copy a group of cells using relative references in vba

rad_melb

New Member
Joined
Aug 5, 2007
Messages
31
I need to write a macro that travels down a column and once it finds a certain value it copies the next 48 cells and pastes in another sheet. this repeats until an empty cell is reached.

Is there are a command to copy all 48 cells together (remember it has to be a relative reference)? If I knew the cells to copy I could just do for e.g

Range("D2:D49").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
ActiveSheet.Paste

but I dont know the cells to copy until a certain condition is met
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

rad_melb

New Member
Joined
Aug 5, 2007
Messages
31
I guess I am looking for some version of this:

Range(Selection, Selection.End(xlDown)).Select

that selects and copies the next 48 cells, from the active cell, in a column,
as opposed to the line above which selects all cells between activecell and end of column
 
Joined
Jul 30, 2006
Messages
3,656
rad_melb,

What is the sheetname you are searching in?

What is the column in this sheet that you are searching in?

What is the value you are searching for?

Have a great day,
Stan
 

rad_melb

New Member
Joined
Aug 5, 2007
Messages
31
hey stan

i am searching in sheet 'prices 06-07'

I am searching column G which contains the excel formula weekday(). When I find that the excel function weekday() returns 2 (i.e. a monday) then I need to copy a range of 48 cells in column D. This is 48 half hourly prices associated with a monday. I then need to paste that in a newsheet in range("A1:A48").

This process has to repeated using a loop which exits when column G becomes empty. The second time a range of 48 cells is copied it needs to be pasted in range (b1:b48). The third time a range of 48 cells is copied it needs to be pasted in range (c1:c48) and so on

Cheers
Rad
 
Joined
Jul 30, 2006
Messages
3,656
Rad,

Here you go.

Please TEST this FIRST in a COPY of your workbook.

Press and hold down the 'ALT' key, and press the 'F11' key.

Insert a Module in your VBAProject, Microsoft Excel Objects

Copy the below code, and paste it into the Module1.

Code:
Option Explicit
Sub MoveMondaysRowPlus47RowsToNewSheet()
'
    Dim strNewSheetName As String
    Dim lngDataLastRow As Long
    Dim lngDataLoopCounter As Long
    Dim lngNewSheetColumnNumber As Long

    Sheets("prices 06-07").Select
    Range("A1").Select
    Application.ScreenUpdating = False
    Sheets.Add
    strNewSheetName = ActiveSheet.Name
    Sheets(strNewSheetName).Move After:=Sheets("prices 06-07")
    Sheets("prices 06-07").Select
    lngDataLastRow = Range("G" & Rows.Count).End(xlUp).Row + 1
    lngNewSheetColumnNumber = 1
    For lngDataLoopCounter = 2 To lngDataLastRow Step 1
        If Cells(lngDataLoopCounter, "G").Value = 2 Then
            Sheets("prices 06-07").Range("D" & lngDataLoopCounter & ":D" & lngDataLoopCounter + 47).Copy _
                Sheets(strNewSheetName).Cells(1, lngNewSheetColumnNumber)
            lngNewSheetColumnNumber = lngNewSheetColumnNumber + 1
            lngDataLoopCounter = lngDataLoopCounter + 47
        End If
    Next lngDataLoopCounter
    Application.ScreenUpdating = True
End Sub

Please TEST this FIRST in a COPY of your workbook.

Then run the 'MoveMondaysRowPlus47RowsToNewSheet' macro.

Have a great day,
Stan
 

Watch MrExcel Video

Forum statistics

Threads
1,122,481
Messages
5,596,393
Members
414,063
Latest member
N_Bates

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