Добрый день решил создать новую тему, так как вопрос заключается в следующем:
Хочу чтобы чтобы копировались и вставлялись значения которые выбрал сам пользователь, я создал лист бокс с наименованием столбцов, теперь необходимо чтобы выбранные колонки копировались и вставлялись в новый файл, посмотрите пожалуйста так же саму структуру кода, я думаю точно можно что-то сократить или заменить (подробнее в файле примере)
И думаю здесь не помешали бы обработчики ошибок, вы как считаете?
Хочу чтобы чтобы копировались и вставлялись значения которые выбрал сам пользователь, я создал лист бокс с наименованием столбцов, теперь необходимо чтобы выбранные колонки копировались и вставлялись в новый файл, посмотрите пожалуйста так же саму структуру кода, я думаю точно можно что-то сократить или заменить (подробнее в файле примере)
И думаю здесь не помешали бы обработчики ошибок, вы как считаете?
| Код |
|---|
Sub Test()
Dim Dest As Workbook
Dim Source As Range
Dim ConstFilePath As String
Dim ConstFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim n As String
Dim Path As String
Dim arr1 As Variant
Dim arr2 As Variant
Dim cito As String
Dim putin As String
'Создаем два массива для формирования пути к файлам
arr1 = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
arr2 = Array("В.Новгород", "Карелия", "Кубань1", "Кубань2", "Кубань3", "Мари", "Н.Новгород1", "Н.Новгород2", "Н.Новгород3", "Пенза", "Ростов1", "Ростов2", "Ростов3", "Тула", "Ярославль")
'инициализация формы
UserForm1.Show
q = 0
Path = "\\server6.tns\dzo\56\2018\"
cito = "56 2018."
MkDir Path & arr2(q)
For i = 0 To 9
'создаем путь к файлу который будет открыт
putin = Path & cito & arr1(i) & " " & arr2(q) & ".xlsx"
'открываем файл
Workbooks.Open (putin)
Application.DisplayAlerts = False
' Тут вместо значений А В С... нужно чтобы подбирались выбранные пользователем значения, и с этими значениями выполнялось копирование и вставка в новый файл
'A = WorksheetFunction.Match("TypeDoma", [ФЛ_Ф_056!a1:ww1], 0)
'B = WorksheetFunction.Match("TypUL", [ФЛ_Ф_056!a1:ww1], 0)
'C = WorksheetFunction.Match("LS", [ФЛ_Ф_056!a1:ww1], 0)
'j = WorksheetFunction.Match("VOL_IND", [ФЛ_Ф_056!a1:ww1], 0)
'D = WorksheetFunction.Match("N_SERV", [ФЛ_Ф_056!a1:ww1], 0)
'E = WorksheetFunction.Match("SQUARE", [ФЛ_Ф_056!a1:ww1], 0)
'F = WorksheetFunction.Match("ROOMS", [ФЛ_Ф_056!a1:ww1], 0)
'G = WorksheetFunction.Match("MAN_COUNT", [ФЛ_Ф_056!a1:ww1], 0)
'H = WorksheetFunction.Match("STATUS", [ФЛ_Ф_056!a1:ww1], 0)
Set Source = Nothing
On Error Resume Next
'изменить данную процедуру на выделение диапазонов выбранных из ListBox
Set Source = Union(Columns(A), Columns(B), Columns(C), Columns(j), Columns(D), Columns(E), Columns(F), Columns(G), Columns(H))
On Error GoTo 0
'копируем и вставляем выделенные диапазоны на нвоый лист
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).Select
Application.CutCopyMode = False
End With
'сохраняем под новым именем
With Dest
.SaveAs Path & arr2(q) & "\" & cito & arr1(i) & ".xlsx"
On Error Resume Next
End With
'это я не знаю что
Dest.Close savechanges:=True
Application.DisplayAlerts = True
'закрываем книгу
ThisWorkbook.Close
'переходим на следующий файл
Next i
End Sub
|
