How to Sum of all Sheets that meet the criteria From Columns "D"? VBA please help

[punnipah]

Hi

I want the sum of all Sheets that meet the criteria From Columns "D" and then Copy Total to Windows("ReportSMS&IVR" & ".xlsx")
Range("H10").PasteSpecial


This my Code not working

please help me


Global Variables
Dim g_dirMainPath As String
Dim g_dirInputPath As String
Dim g_dirOutputPath As String
Dim g_dirTemplatePath As String
Dim g_wbMacro As Workbook
Dim g_wbSaleVolume As Workbook
Dim g_wbPayment As Workbook
Dim g_wbTemplate As Workbook
Dim g_wbfdd As Workbook
Dim i As Long, p As String
Dim c As Range, lastRow As Long
Dim FolderPath As String
Dim FileName As String
Dim FileSystem As Object
Dim Folder As Object
Dim File As Object
Dim ws As Worksheet
Dim totalSum As Double
Dim LastCol As Long


Sub initial()
Set g_wbMacro = ThisWorkbook
g_dirMainPath = g_wbMacro.path & "\"
g_dirInputPath = g_dirMainPath & "Input\"
g_dirOutputPath = g_dirMainPath & "Output\"
g_dirTemplatePath = g_dirMainPath & "Template\"

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.EnableLivePreview = False
Application.GenerateTableRefs = xlGenerateTableRefStruct
End Sub

Sub finished()
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.EnableLivePreview = True
Application.GenerateTableRefs = xlGenerateTableRefStruct
End Sub

Sub Main()
Call initial
' ==============================================================================================================================================
Dim newDate: newDate = Format(DateAdd("M", -1, Now), "MMMM")
On Error Resume Next
Call wbSetOpen(g_wbTemplate, g_dirTemplatePath, "*Template*.xls*")
On Error GoTo 0

Call wbSaveReplace(g_wbTemplate, g_dirOutputPath + "ReportSMS&IVR", False)

On Error Resume Next
Sheets("Device").Select
On Error GoTo 0


FolderPath = "C:\Users\ABC\Desktop\ReportSMS&IVR\Input\"


FileName = Dir(FolderPath & "*.xls")


Do While FileName <> ""
If InStr(FileName, "Dev") > 0 And InStr(FileName, "BC11") > 1 Then
filePath = FolderPath & FileName


Workbooks.Open filePath


With ActiveWorkbook.Sheets("Page 1")
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
End With


totalSum = totalSum + Range("D" & lastRow).value

ActiveSheet.Range("D" & lastRow).Copy



Windows("ReportSMS&IVR" & ".xlsx").Activate
Range("H10").PasteSpecial



End If


FileName = Dir
Loop

End sub

 

[RudRud]

Thank you Very Much

Glad to assist, If you have any further questions, please don't hesitate to ask/share with us