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

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:

Code:

---

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.

Code:

---

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

---

マナ

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.

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

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.

You can do this using INDIRECT

Code:

---

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

---

マナ

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:

Code:

---

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?

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

Code:

---

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

---