VBA Macro Consolidate Data From Discontiguous Cells In Multiple Sheets To One Master

[tinamiller1]

Someone tried to help me but the answer does not work. I have 301 sheets in a workbook and need to copy certain cells using a macro to a single sheet. The macro works great when I comment out the portion that copies a summation cell. That cell happens to be j43 on every sheet. You will see below the altered code based on input from this board, however it does not copy right. It will cause the other items that are being copy and pasted to not copy right. None of the other cells are summation cells. They are simply the value in that particular cell. If this will not work due to variations of the cells, I can create a separate macro to copy and paste b8, b9, b5, h48 and the summation cell j43. cell b8, b9, b5 happen to be the claim number, the mpin and the date of service. j43 is the summation of the charges. I need this information so I can make sure that my copy and paste worked correctly.

'seventh macro
'copy cells
Sub copycells()
Dim WS As Worksheet, wsum As Worksheet
Dim wb As Workbook
Dim vws As Variant 'Need to use a Variant for iterator
Dim i As Integer, j As String, k As String

i = 0
Set wb = Workbooks("sheet4.xlsm")
Set wsum = wb.Sheets("summary")

'Iterate through the sheets
For Each vws In wb.Sheets
If vws.Name <> "summary" Then
j = CStr(i + 2)
k = CStr(i + 18)
vws.Range("b8").Copy wsum.Range("a" & j)
vws.Range("b9").Copy wsum.Range("b" & j)
vws.Range("b5").Copy wsum.Range("c" & j)
vws.Range("H48").Copy wsum.Range("D" & j)
vws.Range("g13:g31").Copy wsum.Range("e" & j & ":e" & k)
vws.Range("i13:i31").Copy wsum.Range("f" & j & ":f" & k)
vws.Range("j13:j31").Copy wsum.Range("g" & j & ":g" & k)
vws.Range("k13:k31").Copy wsum.Range("h" & j & ":h" & k)
vws.Range("l13:l31").Copy wsum.Range("i" & j & ":i" & k)
vws.Range("k38").Copy wsum.Range("j" & j)
vws.Range("l38").Copy wsum.Range("k" & j)
vws.Range("e2").Copy wsum.Range("l" & j)
Sheets("Sheet4").Range("j43").Copy
Sheets("summary").Range("m" & j).PasteSpecial Paste:=xlPasteValues


i = i + 18
End If
Next
End Sub

I am going to attach what this macro outputs that is wrong and what it looks like when I comment out the 2 lines that begin with sheets, which does work as you will see. Example1 is output of macro and example2 is the sheet that has the data. Remember there are 301 of these sheets with various data but same layout.