Copy same cell on all current and future sheets and paste on sheet 1

0
votes

I have an Excel workbook with many sheets. Each sheet is labeled by month & year. i.e. January 2019, and so on, except for the first and second sheet.

The first sheet is hidden (not doing anything there). The second sheet is named Sales Chart (where I want to paste the data). The rest are the month & year sheets.

I need to copy cells B5:B10 on all current month & year sheets, and also any future sheets (which will follow the month & year pattern). After copying the data, it should paste horizontally (the first sheets info being pasted on row B31, the second on row B32, etc.).

I am using a code I found online. It only copies one sheet. It copies the formulas, instead of the formula results. It copies vertically then pastes vertically, instead of copying vertically then pasting horizontally.

Sub MakeSummaryTable()
Dim ws As Worksheet

Application.ScreenUpdating = True
Sheets(1).Activate

For Each ws In Worksheets
    If ws.Name <> "Sales Chart" Then
        ws.Range("B5:B10").Copy
        ActiveSheet.Paste Range("B31").End(xlUp).Offset(1, 0)
    End If
Next ws

Application.ScreenUpdating = True

End Sub

I expect the code to copy the results on cells B5:B10 from all current sheets and paste it to sheet "Sales Chart" B31-G31 (horizontally) and downwards.

2
excelvba
Does it matter in what order the data is pasted into the Sales Chart sheet? Should the macro copy over the top of Sales Chart cells each time starting from Row 31? What happens when we paste 10 rows of data into Sales Chart but there is already 20 rows of data from the last time the macro ran? – T4roy
I would like it pasted horizontally to use it for a forecast chart. The macro shouldn't paste over anything, unless it is updating the row that corresponds the its sheet. If the macro is ran again, it should update new data only. I guess it could update any old data (which should remain the same because as months go by, all previous data on past months shouldn't change. Its a sales sheet made to reflect performance/sales per month) . – user11616229

2 Answers

0
votes

My solution so far, not sure on best approach for checking if the Month is correct or not.

Sub PasteValuesFromMonthSheets()
    Dim wsChart As Worksheet
    On Error Resume Next
    Set wsChart = ThisWorkbook.Worksheets("Sales Chart")
    On Error GoTo 0
    If wsChart Is Nothing Then
        MsgBox "Cannot find Worksheet 'Sales Chart'.", vbOKOnly
        Exit Sub
    End If

    Dim wsSrc As Worksheet
    Dim lngRowOffset As Long

    For Each wsSrc In ThisWorkbook.Worksheets
        Dim arrSrcName As Variant
        arrSrcName = Split(wsSrc.Name, " ")
        If UBound(arrSrcName) = 1 Then
            If IsNumeric(arrSrcName(1)) Then
                Dim intMonth, intYear As Integer
                intMonth = MonthInt(arrSrcName(0))
                intYear = arrSrcName(1)
                If intMonth > 0 And intYear Like "####" Then
                    wsSrc.Range(wsSrc.Cells(5, 2), wsSrc.Cells(10, 2)).Copy
                    wsChart.Cells(lngRowOffset + 31, 2).PasteSpecial xlPasteValues, , , True
                    lngRowOffset = lngRowOffset + 1
                End If
            End If
        End If
    Next wsSrc

    Set wsChart = Nothing
End Sub

Private Function MonthInt(ByVal MonthString As String) As Integer
    Select Case MonthString
        Case "January"
            MonthInt = 1
        Case "February"
            MonthInt = 2
        Case "March"
            MonthInt = 3
        Case "April"
            MonthInt = 4
        Case "May"
            MonthInt = 5
        Case "June"
            MonthInt = 6
        Case "July"
            MonthInt = 7
        Case "August"
            MonthInt = 8
        Case "September"
            MonthInt = 9
        Case "October"
            MonthInt = 10
        Case "November"
            MonthInt = 11
        Case "December"
            MonthInt = 12
        Case Else
            MonthInt = -1
    End Select
End Function
0
votes

I'm not quite sure what you are trying todo here:

Range("B31").End(xlUp).Offset(1, 0)

But you can try this:

Sub MakeSummaryTable()
Dim ws As Worksheet

Application.ScreenUpdating = False
Sheets(1).Activate

For Each ws In Worksheets
    If ws.Name <> "Sales Chart" Then
        ws.Range("B5:B10").Copy
        If Range("B31").Value = "" Then
            Range("B31").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=True
        Else
            Range("B1048576").End(xlUp).Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=True
        End If
    End If
Next ws

Application.ScreenUpdating = True

End Sub

You add 'PasteSpecial' to use this commands:

Paste:=xlPasteValues

To paste values instead of formulas.

Transpose:=True

To paste horizontally your 'vertical' data and vice versa.

Finally, i used this:

Range("B1048576").End(xlUp).Offset(1, 0).Select

to obtain the last row in column B (assuming there is no other data in columns B:G between the last row and the end of the sheet)