Wasilich, Добрый день. Почему-то при копировании этого кода в рабочую книгу , данные с листа сверки размещаются на непонятном расстояние от друг друга. Еще проблема. Чуть-чуть подредактировал макрос, чтобы копировал данные с накладных и вставлял как значения ( без формул). Для сверки это сработало, а где править то что берется с листа накладные?
[vba]
Код
Sub пробник() Dim iz As Range, ad$, ns&, ws&, ps&, cl&, ok&, dt As Date ad = Selection.Address 'адрес диапазона ns = Range(Selection.Address).Row 'начальная (1-я) строка диапазона ws = Range(Selection.Address).Rows.Count 'всего строк ps = Range(Selection.Address).Row + Range(Selection.Address).Rows.Count - 1 ' последняя cl = ActiveSheet.UsedRange.Columns.Count 'пледний столбец в накладные dt = Cells(ps, "A") ' cl = Range(ad).Columns.Count ' последний столбец выбранного диапазона Sheets("Печать").Range("A4:AM100").MergeCells = False 'снимаем объединение ячеек Sheets("Печать").Range("A4:AM100").ClearContents 'очищаеи ячейки Sheets("Печать").Range("A4:AM100").Borders.LineStyle = xlNone 'удаляем обрамление Sheets("Печать").Range("A4:AM100").Interior.ColorIndex = xlNone 'удаляем цвета
With Sheets("Сверка") ps = .Range("C" & Rows.Count).End(xlUp).Row ok = .UsedRange.Columns.Count 'последний столбец Set iz = .Range("B2:C" & ps) iz.Copy Sheets("Печать").Cells(2, cl) 'копируем В и С Range(.Cells(2, ok), .Cells(ps, ok)).Copy 'копируем последний Sheets("Печать").Cells(2, cl + 2).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _ , SkipBlanks:=False, Transpose:=False End With Sheets("Печать").Select Range(Cells(4, cl + 2), Cells(ps, cl + 2)).Borders.Weight = xlThin 'обрамляе столбец даты Cells(1, cl + 2).Select End Sub
[/vba]
Wasilich, Добрый день. Почему-то при копировании этого кода в рабочую книгу , данные с листа сверки размещаются на непонятном расстояние от друг друга. Еще проблема. Чуть-чуть подредактировал макрос, чтобы копировал данные с накладных и вставлял как значения ( без формул). Для сверки это сработало, а где править то что берется с листа накладные?
[vba]
Код
Sub пробник() Dim iz As Range, ad$, ns&, ws&, ps&, cl&, ok&, dt As Date ad = Selection.Address 'адрес диапазона ns = Range(Selection.Address).Row 'начальная (1-я) строка диапазона ws = Range(Selection.Address).Rows.Count 'всего строк ps = Range(Selection.Address).Row + Range(Selection.Address).Rows.Count - 1 ' последняя cl = ActiveSheet.UsedRange.Columns.Count 'пледний столбец в накладные dt = Cells(ps, "A") ' cl = Range(ad).Columns.Count ' последний столбец выбранного диапазона Sheets("Печать").Range("A4:AM100").MergeCells = False 'снимаем объединение ячеек Sheets("Печать").Range("A4:AM100").ClearContents 'очищаеи ячейки Sheets("Печать").Range("A4:AM100").Borders.LineStyle = xlNone 'удаляем обрамление Sheets("Печать").Range("A4:AM100").Interior.ColorIndex = xlNone 'удаляем цвета