Приложения 9

3. Макросы для создания электронных таблиц для создания цепочки таможенных документов

Sub ПУСК()

'

Workbooks.Open Filename: =" C: \2\LOTOS\ARTIKUL1.xlsx"

Workbooks.Open Filename: =" C: \2\LOTOS\мери.xlsx"

Workbooks.Open Filename: =" C: \2\LOTOS\Книга2.xlsx"

Range(" A12: O719").Select

Selection.ClearContents

With Selection.Interior

.Pattern = xlNone

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlNone

Selection.Borders(xlEdgeTop).LineStyle = xlNone

Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Selection.Borders(xlEdgeRight).LineStyle = xlNone

Selection.Borders(xlInsideVertical).LineStyle = xlNone

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Windows(" мери.xlsm").Activate

End Sub

Sub qqqqqqq()

Windows(" мери.xlsx").Activate

For i = 1 To 100

ActiveSheet.Cells(i, 9).Select

q = Selection

If q < > " " And qq = 0 Then ii = i + 1: qq = 1

If q = " " And qq = 1 Then iii = i - 2: Exit For

Next

For i = iii To ii Step -1

ActiveSheet.Cells(i, 1).Select

q = Selection

Do While q = e

ActiveSheet.Cells(i, 7).Select

Selection = Selection + qwt

ActiveSheet.Cells(i, 9).Select

Selection = Selection + mvl

ActiveSheet.Cells(i, 10).Select

Selection = Selection + fr

ActiveSheet.Cells(i, 11).Select

Selection = Selection + tvl

ActiveSheet.Cells(i, 13).Select

Selection = Selection + ps

ActiveSheet.Cells(i, 14).Select

Selection = Selection + wt

Rows(i + 1).Delete

Exit Do

Loop

e = q

ActiveSheet.Cells(i, 7).Select

qwt = Selection

ActiveSheet.Cells(i, 8).Select

svl = Selection

ActiveSheet.Cells(i, 9).Select

mvl = Selection

ActiveSheet.Cells(i, 10).Select

fr = Selection

ActiveSheet.Cells(i, 11).Select

tvl = Selection

ActiveSheet.Cells(i, 13).Select

ps = Selection

ActiveSheet.Cells(i, 14).Select

wt = Selection

Next

Windows(" спец.xlsm").Activate

End Sub

Sub qwe()

Windows(" Книга2.xlsx").Activate

Sheets(" Лист1").Select

Range(" A12: O719").Select

Selection.ClearContents

With Selection.Interior

.Pattern = xlNone

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlNone

Selection.Borders(xlEdgeTop).LineStyle = xlNone

Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Selection.Borders(xlEdgeRight).LineStyle = xlNone

Selection.Borders(xlInsideVertical).LineStyle = xlNone

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

qq = 0

Windows(" мери.xlsx").Activate

'Windows(" ARTIKUL1.xlsx").Activate

sb = 0

For i = 1 To 100

ActiveSheet.Cells(i, 9).Select

q = Selection

If q < > " " And qq = 0 Then ii = i + 1: qq = 1

If q = " " And qq = 1 Then iii = i - 2: Exit For

Next

q = 12

For i = ii To iii

ActiveSheet.Cells(i, 6).Select

qw = Selection

Do While qw = " SEE BELOW"

vlv = 0

frr = 0

ActiveSheet.Cells(i, 7).Select

qwt = Selection

ActiveSheet.Cells(i, 8).Select

svl = Selection

ActiveSheet.Cells(i, 9).Select

mvl = Selection

ActiveSheet.Cells(i, 10).Select

fr = Selection

ActiveSheet.Cells(i, 11).Select

tvl = Selection

ActiveSheet.Cells(i, 13).Select

ps = Selection

ActiveSheet.Cells(i, 14).Select

wt = Selection

ActiveSheet.Cells(i, 1).Select

art = Selection

Windows(" ARTIKUL1.xlsx").Activate

For iq = 3 To 1000

ActiveSheet.Cells(iq, 2).Select

artart = Selection

Do While artart = art

ActiveSheet.Cells(iq, 3).Select

dev = Selection

ActiveSheet.Cells(iq, 4).Select

tnsmth = Selection

ActiveSheet.Cells(iq, 8).Select

cntr = Selection

ActiveSheet.Cells(iq, 11).Select

nam = Selection

ActiveSheet.Cells(iq, 37).Select

psb = Selection

ActiveSheet.Cells(iq, 9).Select

swt = Selection

Exit For

Exit Do

Loop

Next

Windows(" Книга2.xlsx").Activate

ActiveSheet.Cells(q, 1).Select

Selection = art

ActiveSheet.Cells(q, 2).Select

Selection = tnsmth

ActiveSheet.Cells(q, 3).Select

Selection = nam

ActiveSheet.Cells(q, 9).Select

Selection = Sval

q = q + 1

Windows(" мери.xlsx").Activate

wer = 0

For iw = iii To 100

'wer = 0

ActiveSheet.Cells(iw, 1).Select

qr = Selection

qn = Left(qr, Len(art))

If qn = Left(art, Len(art)) Then qq = iw: wer = 1

If qn = " " And wer = 1 Then qqqqq = iw: Exit For

Next

For qnab = qq + 2 To qqqqq - 1

ActiveSheet.Cells(qnab, 1).Select

artnab = Trim(Selection)

ActiveSheet.Cells(qnab, 5).Select

svalnab = Selection

ActiveSheet.Cells(qnab, 3).Select

qwtnab = Selection

Windows(" ARTIKUL1.xlsx").Activate

For iq = 3 To 1000

ActiveSheet.Cells(iq, 2).Select

artart = Selection

Do While artart = Val(artnab)

ActiveSheet.Cells(iq, 3).Select

dev = Selection

ActiveSheet.Cells(iq, 4).Select

tnsmth = Selection

ActiveSheet.Cells(iq, 8).Select

cntr = Selection

ActiveSheet.Cells(iq, 11).Select

nam = Selection

ee = " "

For ewrr = 0 To 16 Step 4

ActiveSheet.Cells(iq, 17 + ewrr).Select

e = Selection

iqq = 18

Do While e = " 01191"

qwei = 2

ActiveSheet.Cells(iq, 18 + ewrr).Select

If ee = " " Then ee = Selection: qwei = 1

If ee < > " " And qwei = 2 Then ee = ee & ", " & Selection

Exit Do

Loop

Do While e = 10023

ActiveSheet.Cells(iq, 18 + ewrr).Select

eee = Selection

erub = 1

Exit Do

Loop

Next

ActiveSheet.Cells(iq, 9).Select

swt = Selection

ActiveSheet.Cells(iq, 37).Select

'psb = Selection

Exit For

Exit Do

Loop

Next

Windows(" Книга2.xlsx").Activate

ActiveSheet.Cells(q, 1).Select

Selection = artnab

ActiveSheet.Cells(q, 2).Select

Selection = tnsmth

ActiveSheet.Cells(q, 3).Select

Selection = nam

ActiveSheet.Cells(q, 4).Select

Selection = cntr

ActiveSheet.Cells(q, 5).Select

Selection = dev

ActiveSheet.Cells(q, 6).Select

Selection = ee

ActiveSheet.Cells(q, 7).Select

If erub = 1 Then Selection = eee

erub = 0

ActiveSheet.Cells(q, 8).Select

Selection = qwt * qwtnab

ActiveSheet.Cells(q, 9).Select

Selection = svalnab

ActiveSheet.Cells(q, 10).Select

Selection = Round(qwt * qwtnab * svalnab, 2)

vlv = vlv + Selection

ActiveSheet.Cells(q, 11).Select

Selection = Round(fr * (svalnab * qwtnab / svl), 2)

frr = frr + Selection

ActiveSheet.Cells(q, 12).Select

Selection = Round(fr / svl * svalnab * qwtnab, 2) + Round(qwt * qwtnab * svalnab, 2)

ActiveSheet.Cells(q, 13).Select

ActiveSheet.Cells(q, 14).Select

Selection = qwt * qwtnab * swt

q = q + 1

blw = blw + swt

ie = 0

Windows(" мери.xlsx").Activate

Next

wttt = 0

Windows(" Книга2.xlsx").Activate

wttttt = mvl - vlv

wtttt = fr - frr

wttet = q - 1

For e = 12 To q

ActiveSheet.Cells(e, 15).Select '

ee = Selection

ActiveSheet.Cells(e, 14).Select '

eee = Selection

Do While ee = " "

ActiveSheet.Cells(e, 13).Select

If wtte = 0 Then wtte = e

If Round(qwt / psb * eee / qwt / blw, 0) > wttt Then wtte = e: wttt = Round(qwt / psb * eee / qwt / blw, 0)

Selection = Round(qwt / psb * eee / qwt / blw, 0)

ie = ie + Round(qwt / psb * eee / qwt / blw, 0)

ActiveSheet.Cells(e, 15).Select '

Selection = eee * (1 + 1 / (qwt * blw) * (wt - blw * qwt))

Exit Do

Loop

Next

wtt = qwt / psb - ie

ActiveSheet.Cells(wtte, 13).Select

Selection = Selection + wtt

ActiveSheet.Cells(wttet, 10).Select

Selection = Selection + wttttt

ActiveSheet.Cells(wttet, 11).Select

Selection = Selection + wtttt

ActiveSheet.Cells(wttet, 12).Select

Selection = Selection + wttttt + wtttt

Windows(" мери.xlsx").Activate

blw = 0

Exit Do

Loop

Do While qw < > " SEE BELOW"

ActiveSheet.Cells(i, 1).Select

art = Selection

ActiveSheet.Cells(i, 7).Select

qwt = Selection

ActiveSheet.Cells(i, 8).Select

svl = Selection

ActiveSheet.Cells(i, 9).Select

mvl = Selection

ActiveSheet.Cells(i, 10).Select

fr = Selection

ActiveSheet.Cells(i, 11).Select

tvl = Selection

ActiveSheet.Cells(i, 13).Select

ps = Selection

ActiveSheet.Cells(i, 14).Select

wt = Selection

'Windows(" мери.xlsx").Activate

Windows(" ARTIKUL1.xlsx").Activate

For iq = 3 To 1000

ActiveSheet.Cells(iq, 2).Select

artart = Selection

Do While artart = art

ActiveSheet.Cells(iq, 3).Select

dev = Selection

ActiveSheet.Cells(iq, 4).Select

tnsmth = Selection

ActiveSheet.Cells(iq, 8).Select

cntr = Selection

ActiveSheet.Cells(iq, 11).Select

nam = Selection

ActiveSheet.Cells(iq, 17).Select

e = Selection

iqq = 18

ee = " "

For ewrr = 0 To 16 Step 4

ActiveSheet.Cells(iq, 17 + ewrr).Select

e = Selection

iqq = 18

Do While e = " 01191"

qwei = 2

ActiveSheet.Cells(iq, 18 + ewrr).Select

If ee = " " Then ee = Selection: qwei = 1

If ee < > " " And qwei = 2 Then ee = ee & ", " & Selection

Exit Do

Loop

Do While e = 10023

ActiveSheet.Cells(iq, 18 + ewrr).Select

eee = Selection

erub = 1

Exit Do

Loop

Next

ActiveSheet.Cells(iq, 9).Select

swt = Selection

Exit For

Exit Do

Loop

Next

Windows(" Книга2.xlsx").Activate

ActiveSheet.Cells(q, 1).Select

Selection = art

ActiveSheet.Cells(q, 2).Select

Selection = tnsmth

ActiveSheet.Cells(q, 3).Select

Selection = nam

ActiveSheet.Cells(q, 4).Select

Selection = cntr

ActiveSheet.Cells(q, 5).Select

Selection = dev

ActiveSheet.Cells(q, 6).Select

Selection = ee

ActiveSheet.Cells(q, 7).Select

If erub = 1 Then Selection = eee

erub = 0

ActiveSheet.Cells(q, 8).Select

Selection = qwt

ActiveSheet.Cells(q, 9).Select

Selection = svl

ActiveSheet.Cells(q, 10).Select

Selection = mvl

ActiveSheet.Cells(q, 11).Select

Selection = fr

ActiveSheet.Cells(q, 12).Select

Selection = tvl

ActiveSheet.Cells(q, 13).Select

Selection = ps

ActiveSheet.Cells(q, 14).Select

Selection = qwt * swt

ActiveSheet.Cells(q, 15).Select

Selection = wt

q = q + 1

Exit Do

Loop

Windows(" мери.xlsx").Activate

' Windows(" ARTIKUL1.xlsx").Activate

Next

Windows(" Книга2.xlsx").Activate

ActiveSheet.Cells(q + 1, 2).Select

Selection = " Группировка по коду ТНВЭД"

Range(Cells(q + 1, 2), Cells(q + 1, 2)).Select

With Selection.Font

.Name = " Calibri"

.Size = 11

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ThemeColor = xlThemeColorLight1

.TintAndShade = 0

.ThemeFont = xlThemeFontMinor

End With

Selection.Font.Bold = True

ActiveSheet.Cells(q + 2, 2).Select

Selection = " Код ТНВЭД»

ActiveSheet.Cells(q + 2, 4).Select

Selection = " Страна"

ActiveSheet.Cells(q + 2, 8).Select

Selection = " Кол-во"

ActiveSheet.Cells(q + 2, 10).Select

Selection = " Стоимость"

ActiveSheet.Cells(q + 2, 11).Select

Selection = " Фрахт"

ActiveSheet.Cells(q + 2, 12).Select

Selection = " Стоимость, Итого"

ActiveSheet.Cells(q + 2, 13).Select

Selection = " Кол.мест"

ActiveSheet.Cells(q + 2, 14).Select

Selection = " Нетто"

ActiveSheet.Cells(q + 2, 15).Select

Selection = " Брутто"

Range(Cells(q + 2, 2), Cells(q + 2, 15)).Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorDark1

.TintAndShade = -0.149998474074526

.PatternTintAndShade = 0

End With

Selection.Font.Bold = False

Selection.Font.Bold = True

With Selection

.VerticalAlignment = xlCenter

.WrapText = True

.Orientation = 0

.AddIndent = False

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

w = q + 3

Windows(" мери.xlsx").Activate

Windows(" Книга2.xlsx").Activate

For i = 12 To q

ActiveSheet.Cells(i, 2).Select

art = Selection

e = 0

For iq = q + 1 To q + 100

ActiveSheet.Cells(iq, 2).Select

qwt = Selection

If qwt = art Then e = 1

Next

Do While e = 0

For ii = 12 To q

ActiveSheet.Cells(ii, 2).Select

svl = Selection

ActiveSheet.Cells(ii, 4).Select

cntr = Selection

ActiveSheet.Cells(ii, 8).Select

eeeee = Selection

ActiveSheet.Cells(ii, 10).Select

eeee = Selection

ActiveSheet.Cells(ii, 11).Select

eee = Selection

ActiveSheet.Cells(ii, 12).Select

qq = Selection

ActiveSheet.Cells(ii, 13).Select

qqq = Selection

ActiveSheet.Cells(ii, 14).Select

qqqq = Selection

ActiveSheet.Cells(ii, 15).Select

qqqqq = Selection

Do While svl = art

ActiveSheet.Cells(w, 2).Select

Selection = art

ActiveSheet.Cells(w, 4).Select

Selection = cntr

ActiveSheet.Cells(w, 8).Select

Selection = eeeee + Selection

ActiveSheet.Cells(w, 10).Select

Selection = eeee + Selection

ActiveSheet.Cells(w, 11).Select

Selection = eee + Selection

ActiveSheet.Cells(w, 12).Select

Selection = qq + Selection

qeqe = 0

ActiveSheet.Cells(w, 13).Select

Selection = qqq + Selection

If qqq = " NO INFO" Then Selection = " N/A": qeqe = 1

ActiveSheet.Cells(w, 14).Select

Selection = qqqq + Selection

ActiveSheet.Cells(w, 15).Select

Selection = qqqqq + Selection

Exit Do

Loop

Next

w = w + 1

Exit Do

Loop

Next

e = 0

For w = 12 To q

ActiveSheet.Cells(w, 15).Select

qqq = qqq + Selection

ActiveSheet.Cells(w, 14).Select

qqqq = qqqq + Selection

ActiveSheet.Cells(w, 13).Select

qqqqq = qqqqq + Selection

ActiveSheet.Cells(w, 12).Select

qqqqqq = qqqqqq + Selection

ActiveSheet.Cells(w, 11).Select

qqqqqqqq = qqqqqqqq + Selection

ActiveSheet.Cells(w, 10).Select

e = e + Selection

ActiveSheet.Cells(w, 9).Select

qe = qe + Selection

ActiveSheet.Cells(w, 8).Select

qqe = qqe + Selection

Next

ActiveSheet.Cells(q, 15).Select

Selection = qqq

ActiveSheet.Cells(q, 14).Select

Selection = qqqq

ActiveSheet.Cells(q, 13).Select

Selection = qqqqq

ActiveSheet.Cells(q, 12).Select

Selection = qqqqqq

ActiveSheet.Cells(q, 11).Select

Selection = qqqqqqqq

ActiveSheet.Cells(q, 10).Select

Selection = e

ActiveSheet.Cells(q, 9).Select

Selection = qe

ActiveSheet.Cells(q, 8).Select

Selection = qqe

Windows(" Книга2.xlsx").Activate

For i = q + 2 To q + 1000

Cells(i, 2).Select

ee = Selection

If ee = " " Then q = i: Exit For

Next

ActiveSheet.Cells(q + 1, 2).Select

Selection = " Группировка по до1"

Range(Cells(q + 1, 2), Cells(q + 1, 2)).Select

With Selection.Font

.Name = " Calibri"

.Size = 11

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ThemeColor = xlThemeColorLight1

.TintAndShade = 0

.ThemeFont = xlThemeFontMinor

End With

Selection.Font.Bold = True

ActiveSheet.Cells(q + 2, 2).Select

Selection = " Код ТНВЭД(4 знака)"

ActiveSheet.Cells(q + 2, 3).Select

Selection = " Кол-во"

ActiveSheet.Cells(q + 2, 4).Select

Selection = " Стоимость"

ActiveSheet.Cells(q + 2, 5).Select

Selection = " Фрахт"

ActiveSheet.Cells(q + 2, 6).Select

Selection = " Стоимость, Итого"

ActiveSheet.Cells(q + 2, 7).Select

Selection = " Кол.мест"

ActiveSheet.Cells(q + 2, 8).Select

Selection = " Нетто"

ActiveSheet.Cells(q + 2, 9).Select

Selection = " Брутто"

Range(Cells(q + 2, 2), Cells(q + 2, 15)).Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorDark1

.TintAndShade = -0.149998474074526

.PatternTintAndShade = 0

End With

Selection.Font.Bold = False

Selection.Font.Bold = True

With Selection

.VerticalAlignment = xlCenter

.WrapText = True

.Orientation = 0

.AddIndent = False

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

w = q + 3

Windows(" мери.xlsx").Activate

Windows(" Книга2.xlsx").Activate

For i = 12 To q

ActiveSheet.Cells(i, 2).Select

art = Left(Selection, 4)

e = 0

For iq = q + 1 To q + 100

ActiveSheet.Cells(iq, 2).Select

qwt = Left(Selection, 4)

If qwt = art Then e = 1

Next

Do While e = 0

For ii = 12 To q

ActiveSheet.Cells(ii, 2).Select

svl = Selection

ActiveSheet.Cells(ii, 4).Select

cntr = Selection

ActiveSheet.Cells(ii, 8).Select

eeeee = Selection

ActiveSheet.Cells(ii, 10).Select

eeee = Selection

ActiveSheet.Cells(ii, 11).Select

eee = Selection

ActiveSheet.Cells(ii, 12).Select

qq = Selection

ActiveSheet.Cells(ii, 13).Select

qqq = Selection

ActiveSheet.Cells(ii, 14).Select

qqqq = Selection

ActiveSheet.Cells(ii, 15).Select

qqqqq = Selection

Do While Left(svl, 4) = art

ActiveSheet.Cells(w, 2).Select

Selection = art

ActiveSheet.Cells(w, 3).Select

Selection = eeeee + Selection

ActiveSheet.Cells(w, 4).Select

Selection = eeee + Selection

ActiveSheet.Cells(w, 5).Select

Selection = eee + Selection

ActiveSheet.Cells(w, 6).Select

Selection = qq + Selection

qeqe = 0

ActiveSheet.Cells(w, 7).Select

Selection = qqq + Selection

If qqq = " NO INFO" Then Selection = " N/A": qeqe = 1

ActiveSheet.Cells(w, 8).Select

Selection = qqqq + Selection

ActiveSheet.Cells(w, 9).Select

Selection = qqqqq + Selection

Exit Do

Loop

Next

w = w + 1

Exit Do

Loop

Next

End Sub

Sub арт()

Windows(" ARTIKUL1.xlsx").Activate

Range(" B514").Select

End Sub

Sub возврат()

Windows(" спец.xlsm").Activate

End Sub

Sub Mr_Wolf()

MsgBox (" Приветствую. Я - мистер Вульф, мое занятие - решение чужих проблем. На данный момент я попытаюсь решить проблему с неправильными значениями веса в спецификации.")

MsgBox (" Что, файл в котором находится вес называется по другому? Отлично. Называйте его как вам вздумается.")

MsgBox (" Так вот. Проблема может быть решена двумя методами.")

eq = 1

Do While eq = 1

ee = MsgBox(" 1 метод. Я разбираюсь с проблемой сам. в таком случае нажимайте на ОК", vbOKCancel)

If ee = vbOK Then eq = 3

Do While ee < > vbOK

ee = MsgBox(" 2 метод. Вы можите задать точный процент разницы между весами. Нажимайте на ОК и введите его в следующее окно.", vbOKCancel)

qq = InputBox(" Разница в процентах.% писать не нужно.")

If ee = vbOK Then eq = 2

Exit Do

Loop

Loop

For i = 12 To 200

ActiveSheet.Cells(i, 15).Select

e = Selection

If e = " " Then Exit For

Next

For ii = 12 To i - 2

ActiveSheet.Cells(ii, 15).Select

e = Selection

ActiveSheet.Cells(ii, 14).Select

If eq = 3 Then Selection = e * (0.95 - Rnd() / 5): eqq = eqq + Selection

If eq = 2 Then Selection = e * (1 - qq / 100): eqq = eqq + Selection

Next

ActiveSheet.Cells(i - 1, 14).Select

Selection = eqq

MsgBox (" Думаете мистер Вульф забыл о группировке по кодам? ")

MsgBox (" Ничего подобного")

w = i + 2

For iq = i + 2 To i + 100

ActiveSheet.Cells(iq, 14).Select

If Selection = " " Then Exit For

Selection = 0

ActiveSheet.Cells(iq, 2).Select

Selection = 0

Next

For iii = 12 To i - 1

ActiveSheet.Cells(iii, 2).Select

art = Selection

e = 0

For iq = i + 1 To i + 100

ActiveSheet.Cells(iq, 2).Select

If Selection = " " Then Exit For

qwt = Selection

If qwt = art Then e = 1

Next

Do While e = 0

For ii = 12 To i

ActiveSheet.Cells(ii, 2).Select

svl = Selection

ActiveSheet.Cells(ii, 14).Select

qqqq = Selection

Do While svl = art

ActiveSheet.Cells(w, 2).Select

Selection = art

ActiveSheet.Cells(w, 14).Select

Selection = qqqq + Selection

Exit Do

Loop

Next

w = w + 1

Exit Do

Loop

Next

End Sub

Sub home()

' home Макрос

Windows(" ARTIKUL1.xlsx").Activate

ActiveWindow.Close

Windows(" мери.xlsx").Activate

ActiveWindow.Close

Windows(" Книга2.xlsx").Activate

ActiveWindow.Close

End Sub