Sub OTKR()
ddate = DateAdd("d", 0, Sheets("Menu").Cells(3, 3).Value)
ddate1 = ddate + 1
ddate2 = ddate + 2
ddate3 = ddate + 3
fDate = Format(ddate, "m\/d\/yyyy")
Dim ITK, IOK As String
Dim iLast As Long
Dim iFirst As String
Dim iName As String
Dim iName1 As String
Dim iName2 As String
Dim iName3 As String
Dim iName4 As String
ITK = ThisWorkbook.Name
sDay = Format(ddate, "dd")
sMonth = Format(ddate, "mm")
sYear = Format(ddate, "yyyy")
sDay1 = Format(ddate1, "dd")
sMonth1 = Format(ddate1, "mm")
sYear1 = Format(ddate1, "yyyy")
sDay2 = Format(ddate2, "dd")
sMonth2 = Format(ddate2, "mm")
sYear2 = Format(ddate2, "yyyy")
iYmd = sYear + sMonth + sDay
iYmd1 = sYear1 + sMonth1 + sDay1
iYmd2 = sYear2 + sMonth2 + sDay2
iName = "33_D" & iYmd & ".xlsx"
iName1 = "33_D" & iYmd1 & ".xlsx"
iName2 = "33_D" & iYmd2 & ".xlsx"
iName3 = "16_D" & iYmd1 & ".xlsx"
iName4 = "16_D" & iYmd2 & ".xlsx"
iPapka = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName
iPapka1 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName1
iPapka2 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName2
iPapka3 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName3
iPapka4 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName4
indir = sDay + sMonth
odir = "C:\Users\eabuzyarov\Desktop\d140\d140_" & indir & ".txt"
IOK = Dir(odir)
inp = Mid(odir, 4)
inp2 = Right(inp, 13)
Inp3 = Left(inp, 3)
SSheet1 = Mid(ddate, 4)
SSheet2 = Left(SSheet1, 2)
With Application
.ScreenUpdating = False
.Visible = True
.DisplayAlerts = False
End With
Workbooks.OpenText Filename:= _
odir, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Columns("A:AQ").Select
Selection.AutoFilter
Selection.AutoFilter Field:=25, Criteria1:="<>0", Operator:=xlAnd
Selection.AutoFilter Field:=17, Criteria1:="<>*Direct*", Criteria2:="<>*cash*", Operator:=xlAnd
Range("Z2:Z1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(LastRow, 1).Offset(1, 0).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(IOK).Activate
Range("O2:O1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 1).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(IOK).Activate
Range("Q2:Q1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 2).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(IOK).Activate
Range("V2:V1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 3).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(IOK).Activate
Range("AA2:AA1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 4).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(IOK).Activate
Range("Y2:Y1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 5).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(IOK).Activate
Range("AK2:AK1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 6).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(IOK).Activate
Range("T2:T1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 7).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(IOK).Activate
Range("U2:U1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 8).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
lLastCol = Cells(LastRow + 1, Columns.Count).End(xlToLeft).Column
lLastRow = Cells(LastRow + 1, 3).End(xlDown).Row
ActiveWorkbook.Worksheets(SSheet2).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(SSheet2).Sort.SortFields.Add Key:=Range(Cells(LastRow + 1, 6), Cells(LastRow, 6)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(SSheet2).Sort
.SetRange Range(Cells(LastRow + 1, 1), Cells(lLastRow, 9))
.Header = xlNo
.MatchCase = True
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Windows(IOK).Activate
Windows(IOK).Close
Workbooks.OpenText Filename:= _
iPapka1, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
INK = Dir(iPapka)
INK1 = Dir(iPapka1)
INK2 = Dir(iPapka2)
INK3 = Dir(iPapka3)
INK4 = Dir(iPapka4)
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd
Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
xlFilterValues, Criteria2:=Array(2, fDate)
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK1).Activate
ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK1).Activate
Windows(INK1).Close
iLast = Cells(Rows.Count, 11).End(xlUp).Row
Workbooks.OpenText Filename:= _
iPapka2, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd
Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
xlFilterValues, Criteria2:=Array(2, fDate)
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK2).Activate
ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK2).Activate
Windows(INK2).Close
iLast = Cells(Rows.Count, 11).End(xlUp).Row
Workbooks.OpenText Filename:= _
iPapka3, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd
Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
xlFilterValues, Criteria2:=Array(2, fDate)
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK3).Activate
ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK3).Activate
Windows(INK3).Close
iLast = Cells(Rows.Count, 11).End(xlUp).Row
Workbooks.OpenText Filename:= _
iPapka4, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd
Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
xlFilterValues, Criteria2:=Array(2, fDate)
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK4).Activate
ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK4).Activate
Windows(INK4).Close
End Sub
|