Sub копиясосновного() 'Sheets("ПЕРВЫЙ").Select Dim otkuda As Range, kuda As Range Sheets("ВТОРОЙ").Range("A2:G30").ClearContents With Sheets("ПЕРВЫЙ") ps = .Range("d" & .Rows.Count).End(xlUp).Row For i = 1 To 7 If .Cells(1, i) <> "" Then Set otkuda = .Range(.Cells(2, i), .Cells(ps, i)).SpecialCells(xlVisible) Set kuda = Sheets("ВТОРОЙ").Cells(3, i) otkuda.Copy kuda End If Next End With Sheets("ОСНОВНОЙ").Select End Sub
[/vba]
Здравствуйте. [vba]
Код
Sub копиясосновного() 'Sheets("ПЕРВЫЙ").Select Dim otkuda As Range, kuda As Range Sheets("ВТОРОЙ").Range("A2:G30").ClearContents With Sheets("ПЕРВЫЙ") ps = .Range("d" & .Rows.Count).End(xlUp).Row For i = 1 To 7 If .Cells(1, i) <> "" Then Set otkuda = .Range(.Cells(2, i), .Cells(ps, i)).SpecialCells(xlVisible) Set kuda = Sheets("ВТОРОЙ").Cells(3, i) otkuda.Copy kuda End If Next End With Sheets("ОСНОВНОЙ").Select End Sub
а всё потомучто вы запускаете макрос с кнопки которая находится на лист ОСНОВНОЙ. Необходимо указывать родителя диапазона к которому вы обращаетесь. С позволения Pelena (думаю не будете она против) дополню её код. [vba]
Код
Option Explicit
Sub копиясосновного() Dim otkuda As Range, kuda As Range
With ThisWorkbook.Worksheets("ВТОРОЙ") .Range("A2:G30").ClearContents
With .Cells .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With
End With
With ThisWorkbook.Worksheets("ПЕРВЫЙ") Dim ps As Long, i As Long ps = .Range("d" & .Rows.Count).End(xlUp).Row
For i = 1 To 7
If .Cells(1, i) <> "" Then Set otkuda = .Range(.Cells(2, i), .Cells(ps, i)).SpecialCells(xlVisible) Set kuda = ThisWorkbook.Worksheets("ВТОРОЙ").Cells(3, i) Selection.Borders(xlDiagonalDown).LineStyle = xlNone otkuda.Copy kuda End If
а всё потомучто вы запускаете макрос с кнопки которая находится на лист ОСНОВНОЙ. Необходимо указывать родителя диапазона к которому вы обращаетесь. С позволения Pelena (думаю не будете она против) дополню её код. [vba]
Код
Option Explicit
Sub копиясосновного() Dim otkuda As Range, kuda As Range
With ThisWorkbook.Worksheets("ВТОРОЙ") .Range("A2:G30").ClearContents
With .Cells .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With
End With
With ThisWorkbook.Worksheets("ПЕРВЫЙ") Dim ps As Long, i As Long ps = .Range("d" & .Rows.Count).End(xlUp).Row
For i = 1 To 7
If .Cells(1, i) <> "" Then Set otkuda = .Range(.Cells(2, i), .Cells(ps, i)).SpecialCells(xlVisible) Set kuda = ThisWorkbook.Worksheets("ВТОРОЙ").Cells(3, i) Selection.Borders(xlDiagonalDown).LineStyle = xlNone otkuda.Copy kuda End If