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")