hello my dear,
i want your help in this Code ..
How to put this Yellow Row As Total After day 15 and last day in Every month ?
After Transfer from Main Sheet to Every Sheets
for example in July Month , i want to add yellow Row after to make transfer from main sheet to another sheets in after 15/07/2020 and another one after 31/07/2020
thanks alot
i want your help in this Code ..
How to put this Yellow Row As Total After day 15 and last day in Every month ?
After Transfer from Main Sheet to Every Sheets
for example in July Month , i want to add yellow Row after to make transfer from main sheet to another sheets in after 15/07/2020 and another one after 31/07/2020
thanks alot
Code:
Sub Test()
Dim x, y, ws As Worksheet, sh As Worksheet, rng As Range, r As Long, m As Long
Dim z As Long
UseSpeedyCode True
Set ws = ThisWorkbook.Worksheets("Main")
z = ws.Cells(Rows.Count, 1).End(xlUp).Row
For r = 3 To z
If Evaluate("ISREF('" & ws.Cells(r, 3).Value & "'!A1)") Then
Set sh = ThisWorkbook.Worksheets(ws.Cells(r, 3).Value)
m = sh.Cells(Rows.Count, 18).End(xlUp).Row + 1
c = WorksheetFunction.CountIfs(sh.Range("a3:a" & m), _
ws.Cells(r, 1), sh.Range("r3:r" & m), ws.Cells(r, 2))
If c > 0 Then GoTo 1
sh.Cells(m, 1).Value = ws.Cells(r, 1).Value
sh.Cells(m, 18).Value = ws.Cells(r, 2).Value
sh.Cells(m, 19).Value = WorksheetFunction.SumIfs( _
ws.Range("g3:g" & z), ws.Range("a3:a" & z) _
, sh.Cells(m, 1).Value, ws.Range("b3:b" & z), _
sh.Cells(m, 18).Value, ws.Range("c3:c" & z), sh.Name)
sh.Cells(m, 20).Value = WorksheetFunction.SumIfs( _
ws.Range("h3:h" & z), ws.Range("a3:a" & z) _
, sh.Cells(m, 1).Value, ws.Range("b3:b" & z), _
sh.Cells(m, 18).Value, ws.Range("c3:c" & z), sh.Name)
For x = 3 To 15 Step 4
For y = x  1 To x + 2
sh.Cells(m, y).Value = WorksheetFunction.SumIfs( _
ws.Range("d3:d" & z), ws.Range("a3:a" & z), _
sh.Cells(m, 1).Value, ws.Range("b3:b" & z), _
sh.Cells(m, 18).Value, ws.Range("c3:c" & z), _
sh.Name, ws.Range("e3:e" & z), sh.Cells(1, x).Value, _
ws.Range("f3:f" & z), sh.Cells(2, y).Value)
Next
Next
End If
1
Next r
UseSpeedyCode False
MsgBox "Done...", 64
End Sub
Public Function UseSpeedyCode(goFast As Boolean)
Dim calc As Long
With Application
.ScreenUpdating = Not goFast
.EnableEvents = Not goFast
If goFast Then
calc = .Calculation
.Calculation = xlCalculationManual
Else
.Calculation = calc
End If
End With
End Function
Sub Nor()
For x = 3 To 15 Step 4
For z = x  1 To x + 2
MsgBox Cells(1, x)
MsgBox Cells(2, z)
Next
Next
End Sub
Attachments

31.2 KB Views: 14

260.1 KB Views: 8