ابو مالك ابرش

If DCount("*", "tbl1", "[Date]= form![Date]") = 1 ThenMsgBox ("مكرر"): Undo

مشكور جدا الكود اشتغل 100%

مشكووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووور اخ  عبد السلام ابو العوافي ضبط 100% 

و شكرا لكل من تفاعل معي 

بس انا قمت بتغير بسيط بالنسبة لل FOR I= 1 TO 6  صارت FOR I = 6 TO 17 عشان تبقى تحسب من العمود F  الى العمود Q

السلام عليكم ورحمة الله و بركاته

اخي عندي هاد الكود يجمع عمود a فقط وانا اريد ان يكرر العملية باكثر من عمود مثلا من العمود a الى العمود f مثلا

Sub anwar_abo_malik_Sum()
LstRow1 = Range("A" & Rows.Count).End(xlDown).Row
Range("A" & LstRow1).Value = ""
With Range("A4:A" & LstRow1)
    .Font.Bold = False
.Interior.ColorIndex = 0
End With
LstRow2 = Range("A" & Rows.Count).End(xlDown).Row
X = Application.WorksheetFunction.Sum(Range("A4:A" & LstRow2))
Range("A1") = X
 With Range("A1")
 .Interior.ColorIndex = 8
    .Font.Bold = True
End With
End Sub
 

Sheets("sheet1").Select
Range("v4:b" & Cells(Rows.Count, "b").End(xlUp).Row).Select
ActiveSheet.Range("v4:b" & Cells(Rows.Count, "b").End(xlUp).Row + 1).RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
      Header:=xlNo
  

'=======================================================

 
    Range("v4:b" & Cells(Rows.Count, "b").End(xlUp).Row).Select
    ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add Key:=Range("d4:d" & Cells(Rows.Count, "d").End(xlUp).Row) _
         , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add Key:=Range("b4:b" & Cells(Rows.Count, "b").End(xlUp).Row) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add Key:=Range("c4:c" & Cells(Rows.Count, "c").End(xlUp).Row) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add Key:=Range("e4:e" & Cells(Rows.Count, "e").End(xlUp).Row) _
       , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add Key:=Range("s4:s" & Cells(Rows.Count, "s").End(xlUp).Row) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add Key:=Range("t4:t" & Cells(Rows.Count, "t").End(xlUp).Row) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("sheet1").Sort
       .SetRange Range("B4:V10000")
       .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With
    Range("B4").Select
      

السلام عليكم اخواني للافاضل 

اريد صيفة جمع عمود متغير الطول وتكون النتيجة باول خلية بطريقة vba