Страницы: 1
RSS
Сохранение столбцов в отдельный файл (xlsx) макросом
 
Подскажите, пожалуйста, как сохранить столбцы в отдельный файл?
Что поправить в коде, чтобы в файл сохранялся не весь лист, а столбцы A:F ?

Код
Sub Сохранить_НД_в_лист()
Application.ScreenUpdating = False                              
Dim path As String, iLinks As Variant, i As Long
 
vopros = MsgBox("Сохранить форму загрузки НД?", vbYesNo, "Сохранение")
If vopros = vbYes Then
 
    path = ThisWorkbook.path
    ActiveSheet.Copy
    iLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(iLinks) Then
        For i = 1 To UBound(iLinks)
            ActiveWorkbook.BreakLink Name:=iLinks(i), Type:=xlExcelLinks
        Next i
    End If
    ActiveWorkbook.SaveAs path & Application.PathSeparator & ActiveSheet.Name & " " & Range("B10") & " " & Range("B11") & ".xlsx" 
    ActiveWorkbook.Close (False)
    MsgBox "Форма сохранена в папку", vbInformation, "Важное сообщение:"

End Sub

 
Maxim,
Код
Sub Сохранить_НД_в_лист()
Application.ScreenUpdating = False
Dim path As String, iLinks As Variant, i As Long
  
vopros = MsgBox("Сохранить форму загрузки НД?", vbYesNo, "Сохранение")
If vopros = vbYes Then
  
    path = ThisWorkbook.path
    Range("A:F").Copy
    Workbooks.Add
    ActiveWorkbook.Worksheets(1).Paste
    iLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(iLinks) Then
        For i = 1 To UBound(iLinks)
            ActiveWorkbook.BreakLink Name:=iLinks(i), Type:=xlExcelLinks
        Next i
    End If
    ActiveWorkbook.SaveAs path & Application.PathSeparator & ActiveSheet.Name & " " & Range("B10") & " " & Range("B11") & ".xlsx"
    ActiveWorkbook.Close (False)
    MsgBox "Форма сохранена в папку", vbInformation, "Важное сообщение:"
End If
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, в таком случае копирование происходит не значениями, а полноценными формулами (со связями к родительской книге, соответственно)
И имя листа получается "Лист1 +  ячейка B10 + ячейка B11" , а должно остаться: "Имя текущего листа +  ячейка B10 + ячейка B11"
 
Цитата
Maxim написал:
файл сохранялся не весь лист, а столбцы A:F ?
макрос делает то что вы просили согласно названию темы?
а что у Вас ьам в файле я знать не знаю (его не видел), вставляйте через пастспешл, а имя книги получайте перед созданием новой книги  
Изменено: Mershik - 17.09.2021 16:05:19
Не бойтесь совершенства. Вам его не достичь.
 
Maxim, Mershik всё правильно говорит, в вашем первом сообщение вы не писали, что должны скопироваться только значения, а не формулы, вот по вашему запросу и был написан макрос простого копирования указанных вами столбцов. Если надо копировать только значения без формул, то вы бы сразу это и написали бы в своём сообщении

Код
Sub Сохранить_НД_в_лист()
    Application.ScreenUpdating = False
    Dim path As String, iLinks As Variant, i As Long
    Dim vopros As VbMsgBoxResult, ShtName As String
    
    vopros = MsgBox("Сохранить форму загрузки НД?", vbYesNo, "Сохранение")
    If vopros = vbYes Then
        path = ThisWorkbook.path
        ShtName = ActiveSheet.Name
        Range("A:F").Copy
        Workbooks.Add
        'ActiveWorkbook.Worksheets(1).Paste
        Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Cells(1, 1).Select
        iLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
        If Not IsEmpty(iLinks) Then
            For i = 1 To UBound(iLinks)
                ActiveWorkbook.BreakLink Name:=iLinks(i), Type:=xlExcelLinks
            Next i
        End If
        ActiveWorkbook.SaveAs path & Application.PathSeparator & ShtName & " " & Range("B10") & " " & Range("B11") & ".xlsx"
        ActiveWorkbook.Close (False)
        MsgBox "Форма сохранена в папку", vbInformation, "Важное сообщение:"
    End If
End Sub
 
Цитата
Maxim написал:
ActiveWorkbook.LinkSources(xlExcelLinks)
Сильно сомневаюсь, что сие надобно
Код
Sub Сохранить_НД_в_лист()
    Application.ScreenUpdating = False
    Dim path As String, iLinks As Variant, i As Long, vopros&

    vopros = MsgBox("Сохранить форму загрузки НД?", vbYesNo, "Сохранение")
    If vopros = vbYes Then

        path = ThisWorkbook.path
        ActiveSheet.Copy
        With ActiveWorkbook
            .Sheets(1).UsedRange.Cells.Value = .Sheets(1).UsedRange.Cells.Value
            .Sheets(1).Columns(7).Resize(, .Sheets(1).UsedRange.Columns.Count).Delete
            .SaveAs path & Application.PathSeparator & .Sheets(1).Name & " " & .Sheets(1).Range("B10") & " " & .Sheets(1).Range("B11") & ".xlsx", 51
            .Close False
            MsgBox "Форма сохранена в папку", vbInformation, "Важное сообщение:"
        End With
    End If
End Sub
 
New, Спасибо!
Я, наверное, сформулирую корректно зов моей помощи и прикреплю файл, так будет нагляднее
 
Maxim, ну, вы сперва попробуйте мой код (чуть дополненный код от Mershik) и код от RAN, и если эти 2 кода не срабатывают у вас как надо, то выкладывайте файл.
Изменено: New - 17.09.2021 16:31:18
 
Цитата
Maxim написал:
зов моей помощи
И что человек сказать хотел???  8-0  
Страницы: 1
Наверх