Is it possible to use some of the macro for another Macro ?
Is it possible to use some of the macro for another Macro ?
Could you please state your question clearly?
sorry
Maybe I can not explain what I want because my English is not good; but
How do I create a table according to from a specific range to the end of Existing data?
my file
no file attached! :No
What is the location of the start of the range to be compiled into a table?
Remember To Do the Following....
Use [Code].... [/Code] tags when posting code to the thread.
Mark your thread as Solved if satisfied by using the Thread Tools options.
If posting the same issue to another forum please show the link
You are very kind, thank you so much for your; for assistance .. And have found a solution to the problems in your forum wonderful .. And I have another problem,:
how can changw this range by (i) ???
i = 1000
'' مهم جدا حساب الشحن و العمولات بشكل صحيح
Range("J12") = "=IF(AND(RC23>0,RC17>0),RC23/SUM(R12C23:R1000C23))" ' how can changw this range by (i) ???
Range("R12").FormulaR1C1 = "=IF(AND(RC15>=0,RC16>0),R5C9/SUM(R12C17:R1000C17))"
'' مهم جدا حساب الشحن و العمولات بشكل صحيح
Range("J12") = "=IF(AND(RC23>0,RC17>0),RC23/SUM(R12C23:R1000C23))"
how can i change this range R1000C23 by (i)
Because (i) variable .
in the code:
On Error Resume Next
Dim Last As Long
Dim Count As Integer
Count = 1
Count = D
With ActiveSheet
Last = .Range("G" & .ROWS.Count).End(xlUp).Row
.ROWS(Last).Copy .ROWS(Last + 0).Resize(Count)
.ROWS(Last + 0).Resize(Count).SpecialCells(xlConstants).ClearContents
End With
On Error GoTo 0
Creates new rows each containing such this
Range("J12") = "=IF(AND(RC23>0,RC17>0),RC23/SUM(R12C23:R1000C23))"
:R1000C23))
1000 is not required and a description, but sometimes much less
i can't add file here but I'll put here the code
[VBA]'Option Explicit
Sub GetDataDemo()
' استدعاءبيانات بيان التعبئة من غير حاجة إلى فتحه
If [a12] > 0 Then MsgBox "There is data in the (INVOICE) OR (INVOICE) is not ready!!": Exit Sub ' عند وجود بيانات في الفاتورة يمنع عمل الكود
'*************************************** 'فك الحماية
Call unpass
'***************************************
Dim FilePath$, D
'***************************************
Const FileName$ = "PACKING LIST.XLS"
Const SheetName$ = "paCking list"
FilePath = ActiveWorkbook.Path & "\"
'***************************************
DoEvents
Application.ScreenUpdating = False
'**********Call mak_pak*****************************
'=========================================
'**********لعرض قيمة الفاتورة في التيكست بوكس*****************************
Address = [R5].Address
TOT = Getbaba(FilePath, FileName, SheetName, Address)
'**********لعرض قيمة الفاتورة في التيكست بوكس*****************************
Address = [a5].Address
D = Getbaba(FilePath, FileName, SheetName, Address)
'b = MsgBox("القيمة" & " " & ":" & TOT & vbNewLine & vbNewLine & FileName & " : الملف " & vbNewLine & "The number of styles is : " & D, vbOKCancel + vbQuestion + vbMsgBoxRight, "Confirmation request Packing")
b = MsgBox("سيكون قيمة الفاتورة بالعملة الصينية هو : " & " " & ":" & TOT & vbNewLine & vbNewLine & FileName & " : الملف " & vbNewLine & "عدد أصناف هذه الفاتورة سيكون : " & D, vbOKCancel + vbQuestion + vbMsgBoxRight, "Confirmation request Packing")
If b = vbOK Then
If D = vbOKCancel Then Exit Sub
GoTo 11
'Prompt = " Import items" & vbNewLine & vbNewLine & Path & vbCrLf & " The number of styles is : "
'D = InputBox(Prompt, vbCrLf, Title & D)
'If D = Cancel Then Call pass: Exit Sub
'*************************************** نسخ صفوف المعادلات حسب عدد الأصناف
11
''' مهم جدا حساب الشحن و العمولات بشكل صحيح
Range("J12") = "=IF(AND(RC23>0,RC17>0),RC23/SUM(R12C23:R1000C23))"
Range("R12") = "=IF(AND(RC15>=0,RC16>0),R5C9/SUM(R12C17:R1000C17))"
'' مهم جدا حساب الشحن و العمولات بشكل صحيح
On Error Resume Next
Dim Last As Long
Dim Count As Integer
Count = 1
Count = D
With ActiveSheet
Last = .Range("G" & .ROWS.Count).End(xlUp).Row
.ROWS(Last).Copy .ROWS(Last + 0).Resize(Count)
.ROWS(Last + 0).Resize(Count).SpecialCells(xlConstants).ClearContents
End With
On Error GoTo 0
Address = Range("A5").Address
D = Getbaba(FilePath, FileName, SheetName, Address)
'=========================================
'*************************************** تسلسل
For Row = 1 To D
For Column = 1 To 1
Address = Cells(Row, Column).Address
lRow = Range("a" & ROWS.Count).End(xlUp).Row
Range("a" & lRow).Offset(1, 0).Value = GetData(FilePath, FileName, SheetName, Address)
Next
Next
'*************************************** تسلسل
'*************************************** رقم موديل
Address = Range("A5").Address
D = Getbaba(FilePath, FileName, SheetName, Address)
For Row = 1 To D
For Column = 3 To 3
Address = Cells(Row, Column).Address
lRow = Range("b" & ROWS.Count).End(xlUp).Row
Range("b" & lRow).Offset(1, 0).Value = GetData(FilePath, FileName, SheetName, Address)
Next
Next
'*************************************** رقم موديل
'*************************************** الوصف
For Row = 1 To D
For Column = 2 To 2
Address = Cells(Row, Column).Address
lRow = Range("c" & ROWS.Count).End(xlUp).Row
Range("c" & lRow).Offset(1, 0).Value = GetData(FilePath, FileName, SheetName, Address)
Next
Next
'*************************************** الوصف
'*************************************** الكمية
For Row = 1 To D
For Column = 17 To 17
Address = Cells(Row, Column).Address
lRow = Range("d" & ROWS.Count).End(xlUp).Row
Range("d" & lRow).Offset(1, 0).Value = GetData(FilePath, FileName, SheetName, Address)
Next
Next
'*************************************** الكمية
'*************************************** السعر
For Row = 1 To D
For Column = 16 To 16
Address = Cells(Row, Column).Address
lRow = Range("e" & ROWS.Count).End(xlUp).Row
Range("e" & lRow).Offset(1, 0).Value = GetData(FilePath, FileName, SheetName, Address)
'Columns.AutoFit
Next
Next
'*************************************** السعر
'*************************************** التاريخ
Address = [G5].Address
[c9] = Getbaba(FilePath, FileName, SheetName, Address)
'*************************************** التاريخ
'*************************************** رقم الفاتورة
Address = [C5].Address
[e9] = Getbaba(FilePath, FileName, SheetName, Address)
'*************************************** رقم الفاتورة
'*************************************** أجور الشحن
Address = [C4].Address
[I5] = Getbaba(FilePath, FileName, SheetName, Address)
'*************************************** أجور الشحن
'*************************************** حجم الحاوية
Address = [a4].Address
[g9] = Getbaba(FilePath, FileName, SheetName, Address)
'*************************************** حجم الحاوية
COLUMNS.AutoFit
'*************************************** نسخ صفوف المعادلات حسب عدد الأصناف
[a10] = "=MAX(R[2]C:R[990]C)" 'إعادة عد الأصناف في الفاتورة
Range("j10") = "=SUM(R12C50:R1000C50)" ' جمع المصاريف على الفاتورة
ActiveWorkbook.Worksheets("مبيعات").Names("الفاتورة_دولار").RefersToR1C1 = "=مبيعات!R12C9:R1000C9"
ActiveWorkbook.Worksheets("مبيعات").Names("عمولة_ادخارية").RefersToR1C1 = "=مبيعات!R12C47:R1000C47"
ActiveWorkbook.Worksheets("مبيعات").Names("عمولة_مصاريف").RefersToR1C1 = "=مبيعات!R12C48:R1000C48"
ActiveWorkbook.Worksheets("مبيعات").Names("الفاتورة_يوان_بدون_مصاريف").Refe rsToR1C1 = "=مبيعات!R12C40:R1000C40"
ActiveWorkbook.Worksheets("مبيعات").Names("عمولة_وسيط").RefersToR1C1 = "=مبيعات!R12C46:R1000C46"
ActiveWorkbook.Worksheets("مبيعات").Names("قيمة_الفاتورة").RefersToR1C1 = "=مبيعات!R12C9:R1000C9"
COLUMNS.AutoFit
COLUMNS("F:F").Select
Selection.EntireColumn.Hidden = True
Range(Selection, Selection.End(xlToRight)).Select
COLUMNS("N:IT").Select
Selection.EntireColumn.Hidden = True
'*************************************** ' إعادة ترقيم أسماء النطاقات بعد حذف أصناف الفاتورة
Call pass
If Sheet <> ("main") = False Then
End If
Call acc
Call mak_packing
Call mak_packing_GUANG
Call add_main:
Call short_tot
Call mk_in_jed
End If
'Call BK_IN_GU
'Call BK_JE
End Sub
Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & Range(Address).Range("A8").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function
Private Function Getbaba(Path, File, Sheet, Address)
' تمت إضافته اضطرارا
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
Getbaba = ExecuteExcel4Macro(Data)
End Function[/VBA]