Summary Worksheet - Post Data down column, not across row

[Iceshade]

Hi Guys,

Very new to VBA and barely know what I am doing so all help is appreciated !

I have created a summary sheet which gets data from multiple worksheets. when the data comes across to the summary sheet, it is populating across the row and I just can't get it to populate down the column instead.

Here is my code so far (I am sure it's super messy and could be streamlined but it works...almost")

Sub Summary_All_Worksheets_With_Formulas()
    Dim Sh As Worksheet
    Dim Req As Worksheet
    Dim myCell As Range
    Dim ColNum As Integer
    Dim RwNum As Long
    Dim Basebook As Workbook
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
   
    'Add a worksheet with the name "Requirements Gathering"
    Set Basebook = ThisWorkbook
    Set Req = Worksheets("Requirements Gathering")
    
    'The links to the first sheet will start in row 12
    RwNum = 11
    For Each Sh In Basebook.Worksheets
        If Sh.Name <> Req.Name And Sh.Visible Then
            ColNum = 1
            RwNum = RwNum + 1
            'Copy the sheet name in the A column
            Req.Cells(RwNum, 2).Value = Sh.Name
            For Each myCell In Sh.Range("B9,H10:H20") '<--Change the range
                ColNum = ColNum + 1
                Req.Cells(RwNum, ColNum).Formula = _
                "='" & Sh.Name & "'!" & myCell.Address(False, False)
            Next myCell
        End If
    Next Sh
    Req.UsedRange.Columns.AutoFit
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Any ideas? My brain hurts

 

[steve the fish]

Just tweaking yours a little:

Sub Summary_All_Worksheets_With_Formulas()
    Dim Sh As Worksheet
    Dim Req As Worksheet
    Dim myCell As Range
    Dim ColNum As Integer
    Dim RwNum As Long
    Dim Basebook As Workbook
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
   
    'Add a worksheet with the name "Requirements Gathering"
    Set Basebook = ThisWorkbook
    Set Req = Worksheets("Requirements Gathering")
    
    'The links to the first sheet will start in row 12
    ColNum = 1
    
    For Each Sh In Basebook.Worksheets
        If Sh.Name <> Req.Name And Sh.Visible Then
            RwNum = 11
            ColNum = ColNum + 1
            'Copy the sheet name in the A column
            Req.Cells(RwNum, ColNum).Value = Sh.Name
            For Each myCell In Sh.Range("B9,H10:H20") '<--Change the range
                RwNum = RwNum + 1
                Req.Cells(RwNum, ColNum).Formula = _
                "='" & Sh.Name & "'!" & myCell.Address(False, False)
            Next myCell
        End If
    Next Sh
    
    Req.UsedRange.Columns.AutoFit
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    
End Sub

 

[Iceshade]

Hi Steve ! Thanks a bunch ! - can't believe it was as easy as adding in the ColNum variable (don't know why I didn't think of that) thanks again !