Auto fill a simple formula using a macro

Hi,

I cant seem to come across this issue yet on the internet (altough Im sure it has to be there somewhere).

I have a workbook with a "Total" sheet and then 52 weekly sheets. Currently I paste a report into the weekly sheets, then use a macro to add any missing rows in the sequence (1,2,3,6 ..so a blank row for 4 & 5 is added).

I cant seem to figure out how to set up the total sheet with a formula to copy over the numbers from the weekly sheet. It is only a simple like for like copy of 1 row of data in Column C, Each attempt at a formula cant account for the added blank rows and show as REF.

I know I could just add the formula (=sheet1!C1 etc) after running the macro on the weekly sheets but I would like to have something or someway that avoids me having to add the formula new each time to the total page.

I was thinking of adding a macro button to the total page that would add a formula to each row in a column. Anyone have any suggestions how I could do this or which macro to use ?

I would suggest you upload a small sample of your workbook (total with 3 weekly sheets) to give a better indication of your needs.

Alf

Example 1.xlsm

Hopefully that worked.

As you can see in 'total' D12 shows as #'REF' as I added a blank row in sheet KW3. Column F is the totals before I use the macro on the sheet.

If you use the macro on sheet KW4 you can see the effect I am trying to avoid. Also on another point the macro change the lines in Column A to 1-33 (they are 101-133 now) can this be avoided ?

Is there other info needed that would help people ?

For a start perhaps a macro like this could be of help?

Sub CopyVal()
Dim i As Integer

Sheets("Total").Activate
For i = 2 To Sheets.Count - 2

Sheets("KW" & i).Activate

If WorksheetFunction.CountA(Range("A1:C1")) > 2 Then
    Range("C1:C" & Range("C" & Rows.Count).End(xlUp).Row).Copy
    Sheets("Total").Activate
    Cells(4, 1 + i).PasteSpecial Paste:=xlPasteValues
End If

Next
 
Application.CutCopyMode = False

Sheets("Total").Activate

End Sub

This will loop through all sheets from KW2 to KW52 (in this case) and check if the range A1 to C1 contains more than 2 values. If so it will copy the values in column C to sheet "Total"

Alf

Thanks Alf.

That looks like it has worked perfectly.

scratch that. Found the error. Changed the code to:

Sub CopyVal()
Dim i As Integer

Sheets("Total").Activate
For i = 1 To Sheets.Count - 52

Sheets("KW" & i).Activate

If WorksheetFunction.CountA(Range("A1:C1")) > 2 Then
Range("C1:C" & Range("C" & Rows.Count).End(xlUp).Row).Copy
Sheets("Total").Activate
Cells(4, 2 + i).PasteSpecial Paste:=xlPasteValues
End If

Next

Application.CutCopyMode = False

Sheets("Total").Activate

End Sub


Seems to work fine now. Had to change the number of sheets to 52 and the paste to cell to another one over. Looks to work fine now. (i hope )

Scratch that. scratch that. It works but only till KW3, after that the macro doesnt add any more detail to the 'Totals" page

Im sure I just messed up the code how can I change "Cells(4, 2 + i).PasteSpecial Paste:=xlPasteValues" to work basically right up page for page until 52 ?

actually just tried it again in the full sheet format and when I click it it says....Run-time error '9' subscript out of range...

What might of I done wrong ?

I have sheets from KW1 to KW52

For i = 1 To Sheets.Count - 52

I hope the -52 is a slip up. If you have 52 sheets + sheet "Total" then command

Sheets.Count

will give you 53 as the number but your last sheet is KW52

so the loop is

For i = 1 To Sheets.Count - 1

You should also check the line

Cells(4, 2 + i).PasteSpecial Paste:=xlPasteValues

as this pastes the copied value to row 4 and column 2 + i So for i = 1 result get pasted to C4, and next i = 2 get pasted to D4 and so forth.

As this seem to clear up your problem could you please mark your thread "Solved"


Alf

Ps Thanks for feed back and rep!

To mark your thread solved do the following:
- Go to the first post
- Click edit
- Click Advance
- Just below the word "Title:" you will see a dropdown with the word No prefix.
- Change to Solve
- Click Save

Originally Posted by Alf

For i = 1 To Sheets.Count - 52

I hope the -52 is a slip up. If you have 52 sheets + sheet "Total" then command

Sheets.Count

will give you 53 as the number but your last sheet is KW52

so the loop is

For i = 1 To Sheets.Count - 1

You should also check the line

Cells(4, 2 + i).PasteSpecial Paste:=xlPasteValues

as this pastes the copied value to row 4 and column 2 + i So for i = 1 result get pasted to C4, and next i = 2 get pasted to D4 and so forth.

As this seem to clear up your problem could you please mark your thread "Solved"


Alf

Ps Thanks for feed back and rep!

Hi,

I changed the code back to your suggestions above and when I run it I get the "run-time error '9' subscript isout of range message again.

?

Sheets("Total").Activate
For i = 1 To Sheets.Count - 1

Sheets("KW" & i).Activate

If WorksheetFunction.CountA(Range("A1:C1")) > 2 Then
Range("C1:C" & Range("C" & Rows.Count).End(xlUp).Row).Copy
Sheets("Total").Activate
Cells(4, 3 + i).PasteSpecial Paste:=xlPasteValues
End If

Next

Application.CutCopyMode = False

Sheets("Total").Activate

End Sub

I have a Totals sheet, Sheet 1, Sheet 2 and then KW1 - KW52 if that matters.

Thats solved it.

Thanks Alf. Brillant help.