Copy, paste and sum data from multiple worksheets to one worksheet

[tatendamark]

How would you simultaneously:


1. Copy different range of values from multiple worksheets e.g. Range("E3 : G3").Copy and Range("I3 : DA3").Copy, and paste them into one worksheet "Original Data", one row after the other in the same columns e.g. Column("E:E") and Column("I:I").


2. Sum the range of values from multiple worksheets e.g. Range("H3:H800") and Range("I3:I800"), and paste the result into one worksheet "Original Data", one row after the other.

My attempt, without the summing, but the rows are not copying over correctly, I suspect because of the offset function and Range("I3 : DA3").Copy:

Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Original Data" Then
Sht.Select
Range("E3 : G3").Copy
Range("I3 : DA3").Copy
Sheets("Original Data").Select
Range("E65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.ScreenUpdating = True
Else
End If
Next Sht

End Sub

Your assistance is greatly appreciated.

[mana]

Option Explicit


Sub CombineData()
    Dim Sht As Worksheet
    Dim r As Range
    Dim n As Long
    
    Application.ScreenUpdating = False
    
    Set r = Sheets("Original Data").Range("E65536").End(xlUp)
    
    For Each Sht In ActiveWorkbook.Worksheets
        If Sht.Name <> "Original Data" Then
            Sht.Range("E3 : G3").Copy r.Offset(n + 1)
            Sht.Range("I3 : DA3").Copy r.Offset(n + 2)
            n = n + 2
        End If
    Next Sht

End Sub

マナ

[tatendamark]

The code isn't copying the rows correctly...

I basically want the code to copy rows from Sheet 2 to Sheet 100, and paste them into "Original Data" row by row, but leave Column H and I blank. So in the end Row 3 in "Original Data" will have values of Sheet 2 Row 3, but with Cell H3 and I3 blank. Row 4 in "Original Data" will have values of Sheet 3 Row 3, but with Column H4 and I4 blank, and so on.

[mana]

Please post a sample book with small data and expected results.

[tatendamark]

Please find attached a sample workbook.

I basically want the code to copy rows from Sheet ABC to Sheet KLM, and paste them into "Original Data" row by row, but skip column H. So in the end Row 3 in "Original Data" will have values of Sheet ABC Row 3. Row 4 in "Original Data" will have values of Sheet DEF Row 3, and so on.

And then in column H of "Original Data", I would like the average of each sheets Column !H3:H20.

[mdmackillop]

You can do this using INDIRECT

[mana]

Option Explicit
 
Sub CombineData()
    Dim DstSht As Worksheet
    Dim Sht As Worksheet
    Dim n As Long
     
    Set DstSht = Sheets("Original Data")
    n = DstSht.Cells(Rows.Count, "E").End(xlUp).Row + 1
    
    Application.ScreenUpdating = False
     
    For Each Sht In ActiveWorkbook.Worksheets
        If Sht.Name <> DstSht.Name Then
            Sht.Range("E3:J3").Copy DstSht.Cells(n, "E")
            DstSht.Cells(n, "H").Value = WorksheetFunction.Average(Sht.Columns("H"))
            n = n + 1
        End If
    Next Sht
     
End Sub

マナ

[tatendamark]

Thanks. It worked. There's one more tricky part. In Column H of "Original Data", I would like to get the average of the first 12 non-zero numbers of each sheets Column H.

This is the formula I came up with in excel: SUM(OFFSET(ABC!H1,MATCH(TRUE,INDEX(ABC!H3:H20>1,),0),0,12))/12

How do I convert that to VBA code, so that it loops through all the sheets in the workbook and returns the answers in "Original Data" Column H?

[mana]

> WorksheetFunction.Average(Sht.Columns("H"))


Evaluate("SUM(OFFSET(" & Sht.Name & "!H1,MATCH(TRUE,INDEX(" & Sht.Name & "!H3:H20>0,),0)+1,0,12))/12")