Сохранение диапазона ячеек по кнопке в новый файл

@yulilntv · Регистрация: 06.02.2020

Author24 — интернет-сервис помощи студентам

Добрый день!
Создаю макрос к кнопке, которая выделяет диапазон с A2 до крайней левой и крайней нижней, копирует его в новую книгу и сохраняет ее в формате .xlsx и .pdf.

Код который у меня сейчас есть:

Visual Basic

Sub VoronkaSaveAsDocument()
    Dim M As String
    Dim S As String
    Dim x As Long
    
    M = Range("N1").Value
    
   
    Worksheets("Воронка кандидатов").Activate
    
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.ColumnWidth = 12.9
    Selection.Rows.AutoFit
        
    
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & M & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        
   ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
   Filename:=ThisWorkbook.Path & "\" & M & ".pdf"
  
    ActiveWindow.Close
      Windows("Новый дизайн профилей.xlsm").Activate
 
    Application.ScreenUpdating = True
End Sub

В данном случае он выдает следующую ошибку:

Сохранение диапазона ячеек по кнопке в новый файл

При этом, если заменить :

Visual Basic

1 2	Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _ , SkipBlanks:=False, Transpose:=False

на:

Visual Basic

1 2	ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & M & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

То код работает, но мне необходимо сохранить исходное форматирование, но преобразовать все имеющиеся формулы в значения (в приведенном файле все уже преобразовано в значения, так как вычищена конфи инфа). Количество выводимых строк-динамическое, может быть 5, а может 555.

На всякий случай файл прикрепляю. https://yadi.sk/d/gInQqQV2DeAIBw. Код находится в 4 модуле.

@Hugo121 · 12.05.2020, 14:42

У меня отработало.
Правда строк там не 555, а 1048575, может поэтому у Вас и глючит - вычистите весь мусор под таблицей.

@pashulka · 12.05.2020, 15:16

yulilntv, Если данные под таблицей копировать не нужно и в таблице нет полностью пустых строк, то без проверки корректности указания имени файла (ячейка N1 активного раб.листа) можно и так :

Visual Basic

Private Sub Test()
    Dim wb As Workbook, ws As Worksheet, r As Range
    Dim p$: p = ThisWorkbook.Path & "\" & CStr(Range("N1"))
    
    Set r = ThisWorkbook.Worksheets("Воронка кандидатов").Range("A1").CurrentRegion
    Set wb = Workbooks.Add(xlWBATWorksheet)
    Set ws = wb.Worksheets(1)
    
    r.Copy ws.Range("A1") 'ws.Range(r.Address)
    With ws.Range(r.Address)
         .Value = r.Value
         .ColumnWidth = 12.9
    End With
    
    wb.SaveAs p & ".xlsx", xlOpenXMLWorkbook ', CreateBackup:=False
    ws.ExportAsFixedFormat xlTypePDF, p & ".pdf"
End Sub

Если с определением диапазона вышла промашка, то можно еще протестировать .UsedRange (на замену .Range("A1").CurrentRegion)

@Hugo121 · 12.05.2020, 16:01

Да, имя файла в переменную M = Range("N1").Value я естественно ставил.

@yulilntv · 12.05.2020, 17:10 **[ТС]**

pashulka, спасибо, макрос отрабатывает сохранение, но при таком раскладе он некрасиво сохраняет в PDF. Есть ли возможность сохранить либо с вмещением хотя бы всех столбцов? Сейчас он обрезает на 6 столбце и сохраняет на разные листы.

Можно ли сделать нечто похожее на эти выборы:

@pashulka · 12.05.2020, 17:32

Сообщение от yulilntv

Есть ли возможность сохранить либо с вмещением хотя бы всех столбцов?

Есть, но как увидеть данные без мелкоскопа в таких умещённых столбцах

Visual Basic

With ws.PageSetup
     .LeftMargin = 0 'Application.InchesToPoints(0)
     .RightMargin = 0 'Application.InchesToPoints(0)
     .Zoom = False
     .FitToPagesWide = 1
End With
ws.ExportAsFixedFormat xlTypePDF, p & ".pdf"

@yulilntv · 12.05.2020, 17:35 **[ТС]**

И еще, пыталась адаптировать Ваш код под еще один макрос для другого листа, но с фиксированным диапазоном, получилось следующее:

Visual Basic

Sub SaveAsDocument()
    
     Dim wb As Workbook, ws As Worksheet, r As Range
    Dim p$: p = ThisWorkbook.Path & "\" & CStr(Range("E1")) - изменила ячейку, из которой берется название документа
    
    Set r = ThisWorkbook.Worksheets("Подбор под профиль").Range("A1:D64").CurrentRegion - изменила название листа и пыталась зафиксировать диапазон
    Set wb = Workbooks.Add(xlWBATWorksheet)
    Set ws = wb.Worksheets(1)
    
    r.Copy ws.Range("A1:D64") 'ws.Range(r.Address) - пыталась зафиксировать диапазон
    With ws.Range(r.Address)
         .Value = r.Value
         .ColumnWidth = 32.91
    End With
    
    wb.SaveAs p & ".xlsx", xlOpenXMLWorkbook ', CreateBackup:=False
    ws.ExportAsFixedFormat xlTypePDF, p & ".pdf"
    
End Sub

Но он все равно доходит до первой пустой ячейки и сохраняет лишь часть. Подскажите пожалуйста, что я упустила? В каком месте фиксируется копируемый диапазон?

@pashulka · 12.05.2020, 18:15

У меня нет фиксированного диапазона. У меня используется CurrentRegion, а это выделить ячейку A1 (можно и другую), затем F5, Выделить, Текущую область - Ок. Если такой диапазон определяется правильно, то ничего менять не надо, если нет, повторюсь, сначала пробуйте .UsedRange

А с фиксированным, наоборот, CurrentRegion не нужен. Ничего более менять не нужно.

Visual Basic

1	Set r = ThisWorkbook.Worksheets("Подбор под профиль").Range("A1:D64")

@yulilntv · 12.05.2020, 18:21 **[ТС]**

pashulka, в любом случае, спасибо Вам большое за помощь, это именно то, что мне было необходимо.
Пойду разбираться и адаптировать)

@Hugo121 6944 / 2849 / 548 Регистрация: 19.10.2012 Сообщений: 8,724
	12.05.2020, 14:42	2
	У меня отработало. Правда строк там не 555, а 1048575, может поэтому у Вас и глючит - вычистите весь мусор под таблицей. 0

@Hugo121 6944 / 2849 / 548 Регистрация: 19.10.2012 Сообщений: 8,724
	12.05.2020, 16:01	4
	Да, имя файла в переменную M = Range("N1").Value я естественно ставил. 0

@yulilntv 0 / 0 / 0 Регистрация: 06.02.2020 Сообщений: 16
	12.05.2020, 17:10 [ТС]	5
	pashulka, спасибо, макрос отрабатывает сохранение, но при таком раскладе он некрасиво сохраняет в PDF. Есть ли возможность сохранить либо с вмещением хотя бы всех столбцов? Сейчас он обрезает на 6 столбце и сохраняет на разные листы. Можно ли сделать нечто похожее на эти выборы: 0

@yulilntv 0 / 0 / 0 Регистрация: 06.02.2020 Сообщений: 16
	12.05.2020, 18:21 [ТС]	9
	pashulka, в любом случае, спасибо Вам большое за помощь, это именно то, что мне было необходимо. Пойду разбираться и адаптировать) 0

Сохранение диапазона ячеек по кнопке в новый файл

Решение