Banner

Thursday, April 6, 2017

Worksheet Data TransferTo Multiple Sheets Match Criteria Every Month



Private Sub CommandButton1_Click()
Dim i As Long
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
For a = 1 To 7
x = Application.WorksheetFunction.CountA(Sheets("Sheet" & a).Range("A:A"))
For b = 1 To 4
If Format(Sheet1.Cells(i, 1).Value, "MMMM") = _
Sheets("Sheet" & a).Range("E1").Value Then
Sheets("sheet" & a).Range("A" & x).End(xlToLeft).Offset(1, b - 1).Value = _
Sheet1.Cells(i, b).Value
End If
Next b
Next a
Next i
End Sub

No comments:

Post a Comment

Please do not enter any spam message in comment box