Приветствую Вас гуру Excel. Есть макрос взятый с этого форума написанный Юрий_М . Не много переделан. Подскажите пожалуйста как переделать макрос что бы при копировании строки ячейки этой строки копировались в нужном порядке. Например в таком:
Код
Sub spisok_gsm()
Application.ScreenUpdating = False
Dim LastRow As Long, Rw As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Лист1")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 6 To LastRow
If Cells(i, 11) <> " " Then
Union(Cells(i, 1), Cells(i, 6), Cells(i, 7), Cells(i, 4), Cells(i, 2), Cells(i, 3), Cells(i, 5), Cells(i, 11), Cells(i, 15)).Copy .Cells(Rw, 1)
Rw = Rw + 1
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Sub spisok_gsm()
Dim I&
Dim arrTemp()
arrVal = Range("A2:N" & Cells(Rows.Count, 1).End(xlUp).Row).Value
For I = 1 To UBound(arrVal)
If arrVal(I, 11) <> Empty Then
ReDim Preserve arrTemp(7, N)
arrTemp(0, N) = arrVal(I, 5)
arrTemp(1, N) = arrVal(I, 6)
arrTemp(2, N) = arrVal(I, 3)
arrTemp(3, N) = arrVal(I, 1)
arrTemp(4, N) = arrVal(I, 2)
arrTemp(5, N) = arrVal(I, 4)
arrTemp(6, N) = arrVal(I, 10)
arrTemp(7, N) = arrVal(I, 14)
N = N + 1
End If
Next
With Worksheets("Результат")
.Range("A2:H" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
.Range("A2").Resize(N, 8) = Application.Transpose(arrTemp)
.Cells.EntireColumn.AutoFit 'автоботбор ширины столбцов, если не нужен можно удалить строку
End With
End Sub
Sub spisok_gsm()
Dim I&
Dim arrTemp()
arrVal = Range("A2:N" & Cells(Rows.Count, 1).End(xlUp).Row).Value
For I = 1 To UBound(arrVal)
If arrVal(I, 11) <> Empty Then
ReDim Preserve arrTemp(7, N)
arrTemp(0, N) = arrVal(I, 5)
arrTemp(1, N) = arrVal(I, 6)
arrTemp(2, N) = arrVal(I, 3)
arrTemp(3, N) = arrVal(I, 1)
arrTemp(4, N) = arrVal(I, 2)
arrTemp(5, N) = arrVal(I, 4)
arrTemp(6, N) = arrVal(I, 10)
arrTemp(7, N) = arrVal(I, 14)
N = N + 1
End If
Next
With Worksheets("Результат")
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & lRow).Resize(N, 8) = Application.Transpose(arrTemp)
.Cells.EntireColumn.AutoFit 'автоботбор ширины столбцов, если не нужен можно удалить строку
End With
End Sub
Согласие есть продукт при полном непротивлении сторон