Собрал макрос для работы с файлом, суть его в работе с листами файла и копированием данных с листов на основной лист.
При запуске через окно ВБА или по пути разраб-макросы-выполнить все отлично работает. Назначаю на кнопку - не работает. Чертовщина какая-то для меня.
Public Sub HHHH()
Dim LastRow, LastRow2, Lastcolumn, LastRow3, Lastcolumn2, LastRow4, Lastcolumn3 As Long
Dim a As Long
Dim Rw, Rw2, Rw3, Rw4, Rw5 As Long
ThisWorkbook.Sheets("Неделя").Range("a17:y300") = ""
a = ThisWorkbook.Sheets("Неделя").Cells(2, 2)
LastRow = ThisWorkbook.Sheets("Банк").Cells(Rows.Count, 1).End(xlUp).Row
LastRow2 = ThisWorkbook.Sheets("Поступления").Cells(Rows.Count, 1).End(xlUp).Row
Lastcolumn = ThisWorkbook.Sheets("Поступления").Cells(1, Columns.Count).End(xlToLeft).Column
LastRow3 = ThisWorkbook.Sheets("Затраты").Cells(Rows.Count, 1).End(xlUp).Row
Lastcolumn2 = ThisWorkbook.Sheets("Затраты").Cells(1, Columns.Count).End(xlToLeft).Column
LastRow4 = ThisWorkbook.Sheets("Счета").Cells(Rows.Count, 1).End(xlUp).Row
Lastcolumn3 = ThisWorkbook.Sheets("Счета").Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Банк").Activate
With ThisWorkbook.Sheets("Неделя")
Rw = ThisWorkbook.Sheets("Неделя").Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 1 To LastRow
If Cells(i, 13) = a And Cells(i, 2) > 0 Then
ThisWorkbook.Sheets("Банк").Range(ThisWorkbook.Sheets("Банк").Cells(i, 1), ThisWorkbook.Sheets("Банк").Cells(i, 2)).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw, 1).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Банк").Range(ThisWorkbook.Sheets("Банк").Cells(i, 4), ThisWorkbook.Sheets("Банк").Cells(i, 5)).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw, 3).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Банк").Cells(i, 19).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw, 5).PasteSpecial xlPasteValues
Rw = Rw + 1
End If
Next
End With
With ThisWorkbook.Sheets("Неделя")
Rw2 = ThisWorkbook.Sheets("Неделя").Cells(Rows.Count, 11).End(xlUp).Row + 1
For Z = 1 To LastRow
If Cells(Z, 13) = a And Cells(Z, 3) > 0 Then
ThisWorkbook.Sheets("Банк").Cells(Z, 1).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw2, 11).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Банк").Range(ThisWorkbook.Sheets("Банк").Cells(Z, 3), ThisWorkbook.Sheets("Банк").Cells(Z, 5)).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw2, 12).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Банк").Cells(Z, 22).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw2, 15).PasteSpecial xlPasteValues
Rw2 = Rw2 + 1
End If
Next
End With
With ThisWorkbook.Sheets("Неделя")
ThisWorkbook.Sheets("Поступления").Activate
Rw3 = ThisWorkbook.Sheets("Неделя").Cells(Rows.Count, 6).End(xlUp).Row + 1
For in1 = 1 To Lastcolumn
For in2 = 2 To LastRow2
If Cells(1, in1) = a And Cells(in2, in1) > 0 Then
ThisWorkbook.Sheets("Поступления").Cells(in2, in1).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw3, 8).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Поступления").Range(ThisWorkbook.Sheets("Поступления").Cells(in2, 1), ThisWorkbook.Sheets("Поступления").Cells(in2, 2)).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw3, 6).PasteSpecial xlPasteValues
Rw3 = Rw3 + 1
End If
Next
Next
End With
With ThisWorkbook.Sheets("Неделя")
ThisWorkbook.Sheets("Затраты").Activate
Rw4 = ThisWorkbook.Sheets("Неделя").Cells(Rows.Count, 18).End(xlUp).Row + 1
For out1 = 1 To Lastcolumn2
For out2 = 2 To LastRow3
If Cells(1, out1) = a And Cells(out2, out1) > 0 Then
ThisWorkbook.Sheets("Затраты").Cells(out2, out1).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw4, 21).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Затраты").Cells(out2, 1).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw4, 18).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Затраты").Cells(out2, 3).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw4, 20).PasteSpecial xlPasteValues
Rw4 = Rw4 + 1
End If
Next
Next
End With
With ThisWorkbook.Sheets("Неделя")
ThisWorkbook.Sheets("Счета").Activate
Rw5 = ThisWorkbook.Sheets("Неделя").Cells(Rows.Count, 24).End(xlUp).Row + 1
For bill1 = 1 To Lastcolumn2
For bill2 = 2 To LastRow3
If Cells(1, bill1) = a And Cells(bill2, bill1) > 0 Then
ThisWorkbook.Sheets("Счета").Cells(bill2, bill1).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw5, 25).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Счета").Cells(bill2, 2).Copy
ThisWorkbook.Sheets("Неделя").Cells(Rw5, 24).PasteSpecial xlPasteValues
Rw5 = Rw5 + 1
End If
Next
Next
End With
ThisWorkbook.Sheets("Неделя").Activate
Application.ScreenUpdating = True
End Sub
Помогите плиз решить головоломку.
P.s. нашел странность - после выполнения макроса, остаются данные которые недокопировались с последней операции if
. Может, неправильно данные сохраняются в хранилище данных?
P.s.2. - добавил картинку схемы работы макроса в программе.
Set
.Range("a17:y300") = ""
- вот откуда будет взят этот Range?ThisWorkbook.Sheets("Банк").Range(Cells(Z, 3), Cells(Z, 5)).Copy
- откуда будут взяты эти Cells?