добый день! Все с праздником!!!!  
помогите плиз изменить макрос так чтобы при сохранении кипии он проверял сколько кипий уже имеется и если их 20 то заменял самую раннюю. вот макрос:  
 
  Dim x As String  
   strPath = "c:\Резервные копии Журнала по Ипотеке"  
   On Error Resume Next  
   x = GetAttr(strPath) And 0  
   If Err = 0 Then ' если путь существует - сохраняем копию книги  
       strDate = Format(Now, "dd/mm/yy hh-mm")  
       FileNameXls = strPath & "\" & Left(ActiveWorkbook.Name, _  
            Len(ActiveWorkbook.Name) - 4) & " " & strDate & ".xls"  
       ActiveWorkbook.SaveCopyAs Filename:=FileNameXls  
   Else 'если путь не существует - выводим сообщение  
       MsgBox "Папка " & strPath & " недоступна или не существует!", vbCritical  
   End If

Спасибо! все работает!

Добрый вечер! надо чтобы макрос удалял строки если в 9 столбце, в строках с 15 по 200 значение равно "0"  
Т.е. Если в ячейке "i" значение "0" то вся строка удаляется  
почемуто не получается( исправьте плиз  
 
Dim i As Long  
For i = 15 To 200  
If Cells(i, 9).Value = "0" Then  
Rows("i:9").Delete Shift:=xlUp  
End If

Спасибо Всем огромное! теперь работает!  
Про высоту строк - никого не хотел обидеть - просто у меня они перемещались изначатьно)

{quote}{login=Somebody}{date=24.04.2010 12:20}{thema=}{post}Я бы написал так  
 
Sub Макрос1()  
Dim NewSht As Workbook  
   Application.ScreenUpdating = False  
   ActiveSheet.UsedRange.Copy  
   Set NewSht = Workbooks.Add  
   With NewSht.ActiveSheet  
       With .Range("A1")  
           .PasteSpecial Paste:=xlPasteValues  
           .PasteSpecial Paste:=xlPasteFormats  
       End With  
       .Columns("G:L").ClearContents  
       .Columns("G:L").UnMerge  
       .Range("A1").Select  
   End With  
   Application.ScreenUpdating = True  
End Sub{/post}{/quote}  
 
работает не вставляется ширина столбцов и высота строк

{quote}{login=The_Prist}{date=24.04.2010 12:22}{thema=}{post}Dim wsSh as worksheet  
set wsSh = ActiveSheet  
wsSh.Usedrange.Copy  
Workbooks.Add  
[A1].PasteSpecial xlPasteValues
[A1].PasteSpecial xlPasteFormats
wsSh.Columns("G:L").ClearContents  
wsSh.Columns("G:L").UnMerge  
 
Я заменил Cells на UsedRange, т.к. копирование и вставка всех ячеек листа абсолютно не нужна. Достаточно копировать только используемые на листе. К тому же так быстрее копирование/вставка будет происходить.{/post}{/quote}  
объединенные ячейки не вставляются

{quote}{login=The_Prist}{date=24.04.2010 12:25}{thema=}{post}На самом деле небольшие непонятки:  
>2 нижние строчки применяются к файлу с которого происходило копирование, а не к новому  
 
Судя по коду, эти строки относятся как раз именно к новому файлу, т.к. именно он на тот момент активный. Т.е. очищается все в новой книге.    
 
Я так понял очистить надо именно в исходной книге.{/post}{/quote}  
 
по коду получается что написано так как надо, а по факту макрос удаляет столбцы в старой (надо в новой)

Добрый день! при копировании в новую книгу не получается очистить содержание столбцов G:L в новой книге (2 нижние строчки применяются к файлу с которого происходило копирование, а не к новому). Помогите исправить)  
 
Cells.Copy  
  Workbooks.Add  
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
       :=False, Transpose:=False  
   Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _  
       SkipBlanks:=False, Transpose:=False  
  Columns("G:L").ClearContents  
  Columns("G:L").UnMerge

работает) спасибо

Добрый вечер! Надо чтобы формула с ячейки А6 копировалась до последней заполненой строки в колонке В, почемуто не получается( поправьте пожалуйста.  
 
Sub 111  
Dim LastRow As Long  
Application.ScreenUpdating = False  
astRow = Cells(Rows.Count, 2).End(xlUp).Row  
Cells(LastRow + 1, 1) = Application.WorksheetFunction.AutoFill Destination:=Range("A6:A48"), Type:=xlFillDefault  
 Application.ScreenUpdating = True  
End Sub

{quote}{login=}{date=11.04.2010 10:41}{thema=Re: }{post}{quote}{login=Юрий М}{date=11.04.2010 10:36}{thema=}{post}{/post}{/quote}  
 
LastRow = Cells(Rows.Count, 2).End(xlUp).Row - и порядок...{/post}{/quote}  
Все просто оказывается! Большое спасибо Юрий!  
ЗЫ. Предыдущее сообщение я не отправлял как оно отправилось - не знаю

{quote}{login=}{date=11.04.2010 10:41}{thema=Re: }{post}{quote}{login=Юрий М}{date=11.04.2010 10:36}{thema=}{post}{/post}{/quote}  
 
LastRow = Cells(Rows.Count, 2).End(xlUp).Row - и порядок...{/post}{/quote}  
Всо просто оказывается) Спасибо Юрий

Не тот файл прикрепил

{quote}{login=Юрий М}{date=11.04.2010 10:30}{thema=Re: Re: }{post}{quote}{login=(0_o)}{date=11.04.2010 10:16}{thema=Re: }{post}{quote}{login=Юрий М}{date=11.04.2010 10:07}{thema=}{post}Проверьте.{/post}{/quote}только  сумма постоянно добавляется в 26 строку{/post}{/quote}  
При заданных условиях последней строкой получается 25-ая. Суммы попадают в 26-ую. Какие задать условия, чтобы проверить на другом к-во? И вообще - я бы сначала очищал диапазон.{/post}{/quote}  
можно прокопировать строки на вкладке "Учет" или см.файл

{quote}{login=(0_o)}{date=11.04.2010 10:16}{thema=Re: }{post}{quote}{login=Юрий М}{date=11.04.2010 10:07}{thema=}{post}Проверьте.{/post}{/quote}  
только  сумма постоянно добавляется в 26 строку{/post}{/quote}  
 
сумма добавляется по первому столбцу - а там номер по порядку который прописывается как  
=ЕСЛИ(B8>0;СЧЁТЗ($B$6:B8);"")  
и сумма добавляется в конец "растяжки" колонки А с этой формулой, воможно ли сделать номер по порядку без этой "растяжки"?

{quote}{login=Юрий М}{date=11.04.2010 10:22}{thema=}{post}(0_o), Вы автор темы?{/post}{/quote}  
забыл авторизоваться(

{quote}{login=Юрий М}{date=11.04.2010 10:07}{thema=}{post}Проверьте.{/post}{/quote}  
только  сумма постоянно добавляется в 26 строку

{quote}{login=Юрий М}{date=11.04.2010 10:07}{thema=}{post}Проверьте.{/post}{/quote}  
круто!

Все разобрался )    
Нужен Next перед end sub  
Большое спасибо все работает

{quote}{login=Igor67}{date=11.04.2010 07:57}{thema=}{post}И не обратил сначала внимания - EntireRow это когда через ячейку обращаемся, а когда конкретно знаем номер строки/столбца - можно просто:  
 
Rows(i).Hidden = True{/post}{/quote}  
 
почемуто не получается  
 
Sub Kopir()  
Dim i As Long  
   Sheets("Учет").Select  
   Columns("FW:FW").Select  
   Selection.AutoFilter  
   Selection.AutoFilter Field:=1, Criteria1:="1"  
   Range("FX2:gd50000").Select  
   Selection.Copy  
   Sheets("Основной журнал").Select  
   Range("b6").Select  
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
       :=False, Transpose:=False  
   Range("D12").Select  
   Sheets("Учет").Select  
   Selection.AutoFilter Field:=1  
   Application.CutCopyMode = False  
   Selection.AutoFilter  
   Sheets("Основной журнал").Select  
Rows("7:207").EntireRow.Hidden = False  
For i = 7 To 200  
If Range("H" & i).Value = "" Then  
Rows(i).Hidden = True  
End If  
End Sub  
 
пишет  
complite error:  
For wihtout Next

Надо, чтобы макрос определял есть ли значение в ячейке (колонка H),    
Если ячейка пуста, то вся строка скрывалась, а если есть отображалась  
вот что пишу    
 
Sub Kopir()  
Dim i As Long  
Rows(1:207).EntireRow.Hidden = False  
For i = 7 To 200  
If Hi.Value = "" Then  
Rows(i).EntireRow.Hidden = True  
end if  
end sub  
 
как правильно написать?

{quote}{login=Юрий М}{date=08.04.2010 08:05}{thema=}{post}Ну так чего стесняться? Вам не помощь нужна в написании, а готовый макрос. Так и пишите. И без преднамеренных ошибок (пАмАгите). Иначе больше от меня ни одного совета не получите.{/post}{/quote}  
Спасибо большое Юрий),    
ЗЫ: я именно так и писал - нужен макрос в самом первом сообщении

{quote}{login=Юрий М}{date=08.04.2010 07:49}{thema=}{post}Отчего она у Вас взрывается? Вы же ни одной строчки не написали. Что конкретно не получается?{/post}{/quote}  
Не знаю как эту функцию добавить, ) кнопку поставил... а дальше незнаю что делать)  
пАмАгите ... спасите мою голову

кто-нибудь знает как сделать это?

{quote}{login=Юрий М}{date=06.04.2010 09:09}{thema=Re: Связь}{post}{quote}{login=(0_o)}{date=06.04.2010 08:54}{thema=Связь}{post}на лист Журнал{/post}{/quote}  
А Вы попробуйте (без каких-либо ухищрений) присвоить листу имя "Журнал".{/post}{/quote}  
В файле№2 несколько листов в том числе и лист "Журнал"

Условие:  
1. Есть файл №1 // сохранен на рабочем столе (может быть и вдругом месте)  
2. Есть файл №2 , который всегда находится C:\  
3. файлы разные - файл №1 - исходная информация ; Файл №2 - Журнал учета  
Задача:  
Нужен макрос (будет активироваться в Файле №1 при нажатии на кнопку) который скопирует значения из ячеек A2, C4 и B6 в файл №2 в ячейки B3, C3, D3 (соответственно)на лист Журнал, при этом если данные ячейки уже заняты то на стоку ниже (B4, C4, D4).

{quote}{login=Dophin}{date=26.03.2010 08:22}{thema=}{post}не думали что возможно это связано с тем что Вы округляете?{/post}{/quote}  
надо чтобы в ячейках а2-с2 значение было с 2 знаками после запятой - изменять формат не надо

{quote}{login=тухачевский}{date=26.03.2010 08:11}{thema=}{post}вариант{/post}{/quote}  
а можно это все как-нибудь написать в ячейке d2?

{quote}{login=Dophin}{date=26.03.2010 08:06}{thema=}{post}а число в ячейке Д1 откуда взялось? с чего Вы взяли что неправильно именно расчетное?{/post}{/quote}  
если сложить сумму разбитую по долям - тоне получается первоначальное число

В Ячейках А1, В1, С1 - Указаны доли  
В ячейке D1 - Число (с копейками)  
В Ячейках А2, В2, С2 - Доля упноженная на Число  
В Ячейке D2 Сумма А2, В2, С2 - которая показывает расхождение примерно в 1 копейку  
ВОПРОС  
Как сделать чтобы таких расхождений не было, обязательное условие - в ячейках А2, В2, С2 должны отображаться числа с двумя знаками после запятой  
Файл приложен.