Option Explicit
Sub GetMapicsCodes()
Dim I As Integer, J As Integer, N As Integer, M As Integer, D As Integer
Dim K As Integer, Gio As Double, Sh As Worksheet
Dim Str As String, newTxt As Object, fSo As Object
1 Application.ScreenUpdating = False
Set Sh = Worksheets("Macro")
3 Sh.Range("F5:F20000").Clear
'n = Worksheets("MO").Range("a20000").End(xlUp).Row'
'Part I'
For I = 5 To Sh.Range("A20000").End(xlUp).Row
'Dánh Dáu F1:'
5 If Sh.Range("D" & I).Value = "P2" Then
' Copy Toàn Bo Part I Sang:'
Sh.Range("F5" & ":" & "F" & I - 1).Value = Sh.Range("E5" & ":" & "E" & I - 1).Value
7 Exit For
End If
9 Next I
'Part II, part have the change in code by change the value'
D = I: N = Sh.Range("A20000").End(xlUp).Row - 1
11 M = Sh.Range("J20000").End(xlUp).Row
For J = 5 To M ' Go From Cell I5 To End Of Range Of Data'
13 If Sh.Range("I" & J).Value <> "" Then
For K = I To N ' Go Through Part 2'
' F'
15 If Sh.Range("B" & K).Value = "F" Then
Sh.Range("F" & D).Value = Sh.Range("E" & K).Value
17 D = D + 1
End If
' C'
19 If Sh.Range("B" & K).Value = "C" Then
Sh.Range("F" & D).Value = Sh.Range("E" & K).Value & Sh.Cells(J, Sh.Range("C" & K).Value + 9) & """"
21 D = D + 1
End If
23 Next K
End If
25 Next J
'End Code'
Sh.Range("F" & D).Value = "End Sub"
'Write To File .Mac'
27 Gio = Time
Set fSo = CreateObject("Scripting.FileSystemObject")
29 Set newTxt = fSo.createtextfile(Range("duongdan").Value & "\" & Range("tenfile").Value & ".mac") '"
For J = 5 To Sh.Range("F20000").End(xlUp).Row
31 newTxt.writeline (Sh.Range("F" & J))
Next J
33 Str = MsgBox("MACRO Created in" & Chr(13) & Chr(13) & Range("duongdan").Value & "\" & Range("tenfile").Value & ".mac", vbOKOnly)
'ActiveSheet.Protect ' '"
35 Application.ScreenUpdating = True
End Sub
