Здравствуйте, подскажите как с помощью макроса скопировать значения столбцов с Листа1 на Лист2, файл прилагаю, на 2 листе подписал откуда должны появиться значения
Здравствуйте, подскажите как с помощью макроса скопировать значения столбцов с Листа1 на Лист2, файл прилагаю, на 2 листе подписал откуда должны появиться значенияegorrr907
egorrr907, Добрый вечер, попробуйте такой код. [vba]
Код
Sub Mv() Dim Cr1%, Lr2%, i%, j% Dim Sp Sp = Array(0, 1, 2, 0, 3, 4, 6, 5) With Sheets("Лист 1") Cr1 = .Cells(Rows.Count, 1).End(xlUp).Row - 3 ReDim Ar(1 To Cr1, 1 To 7) For i = 1 To Cr1 For j = 1 To 7 If j <> 3 Then Ar(i, j) = .Cells(i + 3, Sp(j)) Else Ar(i, j) = 1 End If Next Next End With With Sheets("Лист 2") Lr2 = .Cells(Rows.Count, 1).End(xlUp).Row .Range(.Cells(Lr2 + 1, 1), .Cells(Lr2 + Cr1, 7)) = Ar End With End Sub
[/vba]
egorrr907, Добрый вечер, попробуйте такой код. [vba]
Код
Sub Mv() Dim Cr1%, Lr2%, i%, j% Dim Sp Sp = Array(0, 1, 2, 0, 3, 4, 6, 5) With Sheets("Лист 1") Cr1 = .Cells(Rows.Count, 1).End(xlUp).Row - 3 ReDim Ar(1 To Cr1, 1 To 7) For i = 1 To Cr1 For j = 1 To 7 If j <> 3 Then Ar(i, j) = .Cells(i + 3, Sp(j)) Else Ar(i, j) = 1 End If Next Next End With With Sheets("Лист 2") Lr2 = .Cells(Rows.Count, 1).End(xlUp).Row .Range(.Cells(Lr2 + 1, 1), .Cells(Lr2 + Cr1, 7)) = Ar End With End Sub