выборочное копирование данных на другой лист

[D_e_n_n]

вот например, есть баланс за 3 дня месяца. Мне неоходимо взять из всего этого только 3 счета 20202, 30102,40702. затем из 20202 счета необходимо взять "входящий остаток актив" (180383,46) и поместить его в листе с номером 29 если это 29.12.2007 в ячейку С7, затем "дебет" в ячейку С9 тогоже листа, "Исходящий остаток актив" поместить в С10 29 листа, "кредит" поместить в ячейку G9 29 листа этой книги. затем счет 30102 "входящий актив" поместить на лист соответствующий дате если 29.12.2007 то на лист 29 в ячейку С11, "исходящий оборот дебет" поместить в ячейку С26, "кредит" этого счета поместить на лист 29 в ячейку G26. А со счета 40702 нужен только "дебет" и поместить его на лист если он относится к 29.12.2007 на лист 29 в ячейку G13. И так по каждому числу на соответствующий лист.

[D_e_n_n]

я с помощью этого макроса выбераю нужные счета и копирую на отдельный лист
Sub DennDarkk()
Dim y, a, p As Range
Dim i As Integer
Dim s As String

Sheets("Баланс за месяц").Activate
For i = 0 To 9
Do
Set y = Cells.Find(What:="30102", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If y Is Nothing Then Exit Do 'ikolo
y.EntireRow.Copy Sheets("временно").Range("A" & Sheets("временно").Cells.SpecialCells(xlCellTypeLastCell).Row + 1)
y.EntireRow.Delete
Loop
Next i
End Sub
, только вот как после этого в лист с соответствующей датой поставить значения строк

[D_e_n_n]

может все это вообще можно сделать без написания макроса????

[D_e_n_n]

вернее вот этим макросом
Private Sub Worksheet_Activate()
Dim y, a, p As Range
Dim i As Integer
Dim s As String

Sheets("Баланс за месяц").Activate

For i = 0 To 9
Do

Set y = Cells.Find(What:="30102", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
Set a = Cells.Find(What:="20202", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
Set p = Cells.Find(What:="40702", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If y Is Nothing Then Exit Do
y.EntireRow.Copy Sheets("временно").Range("A" & Sheets("временно").Cells.SpecialCells(xlCellTypeLastCell).Row + 1)
y.EntireRow.Delete
If a Is Nothing Then Exit Do
a.EntireRow.Copy Sheets("временно").Range("A" & Sheets("временно").Cells.SpecialCells(xlCellTypeLastCell).Row + 1)
a.EntireRow.Delete
If p Is Nothing Then Exit Do
p.EntireRow.Copy Sheets("временно").Range("A" & Sheets("временно").Cells.SpecialCells(xlCellTypeLastCell).Row + 1)
p.EntireRow.Delete

Loop

Next i
End Sub

[Igor_123]

а чем тебе макрос не нравится???

Автофильтром выбирать нужные данные, копировать, выбирать нужный лист и ячейку и вставлять, если без использования макроса

а зачем там цикл в 9 итераций?

только вот как после этого в лист с соответствующей датой поставить значения строк

находи последнюю строку из скопированных, начало диапазона сделай равным А1 и копируй в нужный лист, после удаляй из временного листа. А?

да ещё и Do ... Loop без всяких условий, он хоть работает код из последнего поста или уходит в бесконецный цикл?

[Viper]

D_e_n_n, во-первых, пользуйся тегами для выделения кода, а то его трудно читать, а во-вторых, вместо размазывания мысли на 4 поста стоило все объеденить в один. При необходимости воспользовавшись кнопкой Правка.

[D_e_n_n]

а чем тебе макрос не нравится???

Автофильтром выбирать нужные данные, копировать, выбирать нужный лист и ячейку и вставлять, если без использования макроса

а зачем там цикл в 9 итераций?

только вот как после этого в лист с соответствующей датой поставить значения строк

находи последнюю строку из скопированных, начало диапазона сделай равным А1 и копируй в нужный лист, после удаляй из временного листа. А?

да ещё и Do ... Loop без всяких условий, он хоть работает код из последнего поста или уходит в бесконецный цикл?

Работает исправно, а про цикл забыл убрать просто с предыдущего задания. Про последнюю строку непонял немного, мне необходимо найти дату счета и тогда уже знать с каким листом работать, что то с этим проблемка
а вот сам макрос почищенный
Private Sub Worksheet_Change(ByVal Target As Range)
Dim y, a, p As Range
Dim i As Integer
Dim s As String

Sheets("Баланс за месяц").Activate
Do
Set y = Cells.Find(What:="30102", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
Set a = Cells.Find(What:="20202", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
Set p = Cells.Find(What:="40702", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If y Is Nothing Then Exit Do
y.EntireRow.Copy Sheets("временно").Range("A" & Sheets("временно").Cells.SpecialCells(xlCellTypeLastCell).Row + 1)
y.EntireRow.Delete
If a Is Nothing Then Exit Do
a.EntireRow.Copy Sheets("временно").Range("A" & Sheets("временно").Cells.SpecialCells(xlCellTypeLastCell).Row + 1)
a.EntireRow.Delete
If p Is Nothing Then Exit Do
p.EntireRow.Copy Sheets("временно").Range("A" & Sheets("временно").Cells.SpecialCells(xlCellTypeLastCell).Row + 1)
p.EntireRow.Delete
Loop

End Sub

[D_e_n_n]

я так понял помощь ждать не от кого

[Igor_123]

а как тебе помочь???

вот например, есть баланс за 3 дня месяца. Мне неоходимо взять из всего этого только 3 счета 20202, 30102,40702. затем из 20202 счета необходимо взять "входящий остаток актив" (180383,46) и поместить его в листе с номером 29 если это 29.12.2007 в ячейку С7, затем "дебет" в ячейку С9 тогоже листа, "Исходящий остаток актив" поместить в С10 29 листа, "кредит" поместить в ячейку G9 29 листа этой книги. затем счет 30102 "входящий актив" поместить на лист соответствующий дате если 29.12.2007 то на лист 29 в ячейку С11, "исходящий оборот дебет" поместить в ячейку С26, "кредит" этого счета поместить на лист 29 в ячейку G26. А со счета 40702 нужен только "дебет" и поместить его на лист если он относится к 29.12.2007 на лист 29 в ячейку G13. И так по каждому числу на соответствующий лист.

из твоих данных в екселе не понятно где

"Исходящий остаток актив", "кредит", "исходящий оборот дебет"

проблема то не сложная, только пример к вопросу не совсем корректен, мягко говоря. Так какой помощи ты ждеш?

[Igor_123]

вобщем вот небольшой пример, разбирайся:

Код: Выделить всё

Option Explicit
' Здесь нужно проставить правильные значения столбцов, откуда брать данные
' и правильные значения адресов ячеек, куда разносить эти данные
Const colVhod_Ost_Aktive = 2
Const cellsVhod_Ost_Aktive = "C7"

Const colDebit = 3
Const cellsDebit = "С9"

Const colIshod_Ost_Aktive = 7
Const cellsIshod_Ost_Aktive = "C10"

Const colKredit = 5
Const cellsKredit = "G9"

Const colVhod_Aktive = 4
Const cellsVhod_Aktive = "C11"

Sub Macros()
Dim nDay As Long
Dim shBalans As Worksheet
Dim shDay As Worksheet
Dim CurRow As Long
CurRow = 2 ' Здесь нужно поставить номер первой строки с данными
Set shBalans = Sheets("Баланс за месяц")
Application.ScreenUpdating=False
Do
nDay = Day(CDate(cells(CurRow, 1).Value))
Set shDay = Sheets(CStr(nDay))
With shDay
    .Range(cellsVhod_Ost_Aktive).Value = shBalans.cells(CurRow, colVhod_Ost_Aktive).Value
    .Range(cellsDebit).Value = shBalans.cells(CurRow, colDebit).Value
    .Range(cellsIshod_Ost_Aktive).Value = shBalans.cells(CurRow, colIshod_Ost_Aktive).Value
    .Range(cellsKredit).Value = shBalans.cells(CurRow, colKredit).Value
    .Range(cellsVhod_Aktive).Value = shBalans.cells(CurRow, colVhod_Aktive).Value
End With
CurRow = CurRow + 1
Loop While Len(Trim(CStr(cells(CurRow, 1).Value))) <> 0
Set shBalans = Nothing
Set shDay = Nothing
Application.ScreenUpdating = True
MsgBox "Закончили!"
End Sub

Дополниш константы остальными значениями интересующих тебя данных и в цикле добавиш строчки для добавленных констант.

И я не совсем, а точнее совсем не понял, почему:

А со счета 40702 нужен только "дебет"

и чем он так примечателен. Такую логику уже нужно реализовывать внутри цикла условиями решая какие данные и куда переносить.

Ну и не помешает ( я бы даже сказал очень нужна ) обработка ошибок

Да и этот код нужно вставлять в отдельный модуль и вызывать из меню "Сервис" - "Макрос" - "Макросы..."

[D_e_n_n]

вобщем вот небольшой пример, разбирайся:

Код: Выделить всё

Option Explicit
' Здесь нужно проставить правильные значения столбцов, откуда брать данные
' и правильные значения адресов ячеек, куда разносить эти данные
Const colVhod_Ost_Aktive = 2
Const cellsVhod_Ost_Aktive = "C7"

Const colDebit = 3
Const cellsDebit = "С9"

Const colIshod_Ost_Aktive = 7
Const cellsIshod_Ost_Aktive = "C10"

Const colKredit = 5
Const cellsKredit = "G9"

Const colVhod_Aktive = 4
Const cellsVhod_Aktive = "C11"

Sub Macros()
Dim nDay As Long
Dim shBalans As Worksheet
Dim shDay As Worksheet
Dim CurRow As Long
CurRow = 2 ' Здесь нужно поставить номер первой строки с данными
Set shBalans = Sheets("Баланс за месяц")
Application.ScreenUpdating=False
Do
nDay = Day(CDate(cells(CurRow, 1).Value))
Set shDay = Sheets(CStr(nDay))
With shDay
    .Range(cellsVhod_Ost_Aktive).Value = shBalans.cells(CurRow, colVhod_Ost_Aktive).Value
    .Range(cellsDebit).Value = shBalans.cells(CurRow, colDebit).Value
    .Range(cellsIshod_Ost_Aktive).Value = shBalans.cells(CurRow, colIshod_Ost_Aktive).Value
    .Range(cellsKredit).Value = shBalans.cells(CurRow, colKredit).Value
    .Range(cellsVhod_Aktive).Value = shBalans.cells(CurRow, colVhod_Aktive).Value
End With
CurRow = CurRow + 1
Loop While Len(Trim(CStr(cells(CurRow, 1).Value))) <> 0
Set shBalans = Nothing
Set shDay = Nothing
Application.ScreenUpdating = True
MsgBox "Закончили!"
End Sub

Дополниш константы остальными значениями интересующих тебя данных и в цикле добавиш строчки для добавленных констант.

И я не совсем, а точнее совсем не понял, почему:

А со счета 40702 нужен только "дебет"

и чем он так примечателен. Такую логику уже нужно реализовывать внутри цикла условиями решая какие данные и куда переносить.

Ну и не помешает ( я бы даже сказал очень нужна ) обработка ошибок

Да и этот код нужно вставлять в отдельный модуль и вызывать из меню "Сервис" - "Макрос" - "Макросы..."

Огромное спасибо, щас попробую