ابو مالك ابرش

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