Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » МВВ МВВ
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
макрос копирование листа Excel в папку
 
#
20.07.2023 13:18:00
Все работает, спасибо.
Только для копирования приходится переходить по листам, а их может быть множество в конечном рабочем файле.
Помогите еще с одной тонкостью...
Хочется работать с файлом на одном листе. Для этого хочу создать кнопки на листе 1, а к ним привязать макрос, Каждая из которых будет сохранять определенный лист активной книги. ( кнопка1 - лист 1, кнопка2-лист2 и т.д.). Так понимаю, что в макросе необходимо прописать конкретный лист который будет скопирован.
Заранее спасибо.
 
Перейти    
макрос копирование листа Excel в папку
 
#
20.07.2023 12:11:05
Доброго времени суток.
В очередной раз обращаюсь к Вам за помощью.
  Требуется макрос для копирования или сохранения одного из листов активной книги в папку указанную в ячейке B7 под именем указанным в ячейке B6
данный макрос будет привязан к нескольким кнопкам, каждая из которых будет сохранять определенный лист активной книги. ( кнопка1 - лист 1, кнопка2-лист2 и т.д.). На просторах интернета удалось найти и доработать следующий макрос:
 Но с ним возникла проблема, он выполняет поставленную задачу только с литом1 (файл прилагаю). При попытке его изменить и проделать тоже с листом 2 и т.д. - выдает ошибку.
 При переносе макроса в окончательный файл перестает работать даже с листом 1
Подскажите, в чем проблема?
Заранее спасибо
Код
Sub SplitSheets()

Worksheets(Array("Лист1")).Copy
With ActiveWorkbook
     .SaveAs Filename:=[B7] & [B6], FileFormat:=xlOpenXMLWorkbook
     .Close SaveChanges:=False
End With

End Sub
 
Перейти    
Макрос по созданию папки с именем ячейки
 
#
17.07.2023 14:00:26
Всем большое спасибо.
Воспользовался вариантом который предложил artemkau88, #29 14.07.2023 17:55:33
Для меня оказался наиболее понятным и простым вариантом, спасибо
 
Перейти    
Макрос по созданию папки с именем ячейки
 
#
14.07.2023 17:36:53
Добрый день. Нужна ваша помощь в создании макроса, так как сам в VBA не силен.

1. Требуется создать папку с именем из ячейки А18
2. Требуется поместить созданную папку используя путь указанный в ячейке  B16 (переменная)
3. требуется копировать папку с подпапками и файлами, путь указан в ячейке С13 в созданную ранее папку

изучив имеющиеся материалы воспользовался макросом предложенным ранее #8 05.09.2017 14:43:13.
Доработав его удалось решить 1. задачу, создать папку с именем указанным в ячейке А18, но возникла проблема, которую не удается решить самостоятельно.
Путь по которому располагается созданная папка "константа", не удается его привязать к ячейке В16 (переменной), подскажите как это реализовать.

А также подскажите возможно ли вписать макрос копирования папок в данный макрос, для решения всех поставленных задач одним действием ?
Код
Sub createFolders()
    Dim fso As Object, el As Range
    ' Выбор ячейки с названием папки
    Set el = Application.InputBox( _
        Prompt:="Выберите строку с названием папки", _
        Title:="Строка с названием", _
        Default:=Intersect([A18], Selection.EntireRow).Address, _
        Type:=8)
    
    ' Папка для создания по умолчанию
    sFldr = "C:\Users\USER\Desktop\СК ТАНДЕР\Отчеты\"
    ' Возмоожность изменить папку
    sFldr = InputBox( _
        Prompt:="Адрес сохранения", _
        Title:="Куда сохранять?", _
        Default:=sFldr)
    If Not el Is Nothing And sFldr <> "" And el.Value <> "" Then
        Set el = Intersect([A1:B18], el)
        If Dir(sFldr, vbDirectory) = "" Then MkDir sFldr ' создаем, если нет
        Set fso = CreateObject("Scripting.FilesystemObject")
        If Not fso.FolderExists(sFldr & el.Value) Then
            fso.CreateFolder (sFldr & el.Value)
        End If
    Else
        MsgBox "Папка или название файла не выбраны.", vbCritical
    End If
End Sub
 
Перейти    
Макрос "печать ", Печать заданных листов и страниц
 
#
09.03.2023 04:09:42
Вроде получилось разобраться. Получился следующий макрос, подскажите если есть возможность его упростить.
Так же выявилась следующие проблемы:
1. После выполнения макроса "Печать" если листы не скрыты открывается меню правой кнопки мыши
2. Скрыл не нужные листы после выполнения макроса "Печать"  курсор перескакивает на следующий не скрытый лист
Подскажите, можно ли убрать данные проблемы и как?
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim n As Long

If Not Intersect(Target, Range("B5")) Is Nothing Then
    Sheets("ТЛ МинКвант").Visible = -1
    Sheets("ТЛ МинКвант").PrintOut From:=1, To:=2, Copies:=2
    Sheets("ТЛ МинКвант").Visible = 0
    End If
    
    If Not Intersect(Target, Range("C5")) Is Nothing Then
    Sheets("ТЛ Штучка").Visible = -1
    Sheets("ТЛ Штучка").PrintOut From:=1, To:=2, Copies:=2
    Sheets("ТЛ Штучка").Visible = 0
    End If
    
    If Not Intersect(Target, Range("D5")) Is Nothing Then
    Sheets("ТЛ Факт").PrintOut From:=1, To:=2, Copies:=2
    End If

    If Not Intersect(Target, Range("E5")) Is Nothing Then
    Sheets("ТЛ МинКвант АК").PrintOut From:=1, To:=2, Copies:=2
    End If
    
    If Not Intersect(Target, Range("F5")) Is Nothing Then
    Sheets("Стрелка").Visible = -1
    Sheets("Стрелка").PrintOut From:=1, To:=1, Copies:=1
    Sheets("Стрелка").Visible = 0
    End If
    
    If Not Intersect(Target, Range("F6")) Is Nothing Then
    Sheets("АКТ").Visible = -1
    Sheets("АКТ").PrintOut From:=1, To:=1, Copies:=1
    Sheets("АКТ").Visible = 0
    End If
    
If Not Intersect(Target, Range("B6")) Is Nothing Then
    n = Fix(Val(Range("C4")))
    If n > 0 Then
    Sheets("Паспорт МинКвант").Visible = -1
    Sheets("Паспорт МинКвант").PrintOut From:=1, To:=n
    Sheets("Паспорт МинКвант").Visible = 0
    End If
    
ElseIf Not Intersect(Target, Range("D6")) Is Nothing Then
    j = Fix(Val(Range("C4")))
    If j > 0 Then
    Sheets("Паспорт Факт").Visible = -1
    Sheets("Паспорт Факт").PrintOut From:=1, To:=j
    Sheets("Паспорт Факт").Visible = 0
    End If
    
ElseIf Not Intersect(Target, Range("C6")) Is Nothing Then
    i = Fix(Val(Range("C4")))
    If i > 0 Then
    Sheets("Паспорт Штучка").Visible = -1
    Sheets("Паспорт Штучка").PrintOut From:=1, To:=i
    Sheets("Паспорт Штучка").Visible = 0
    End If
    
ElseIf Not Intersect(Target, Range("E6")) Is Nothing Then
    m = Fix(Val(Range("C4")))
    If m > 0 Then
    Sheets("Паспорт МинКвант АК").Visible = -1
    Sheets("Паспорт МинКвант АК").PrintOut From:=1, To:=m
    Sheets("Паспорт МинКвант АК").Visible = 0
    End If
End If
End Sub
Изменено: МВВ МВВ - 09.03.2023 04:11:23
 
Перейти    
Макрос "печать ", Печать заданных листов и страниц
 
#
08.03.2023 14:40:09
Спасибо большое, все работает.
Снова прошу Вашей помощи...
На данный момент потребовалось  добавить еще 2 кнопки по аналогии ( в будущем возможно еще потребуется добавить)
1. Макрос "печати" условно на Листе1 "С5" - печатает одну страницу в двух экземплярах с Листа3 в прилагаемом файле лист "ТЛ Штучка"
2. Макрос "печати" на листе 1 "С6"- печатает страницы указанные в определенной ячейке "С4" на Листе1  с листа 4 "ПП Штучка" в одном экземпляре
Заранее Спасибо за помощь.
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim n As Long
If Not Intersect(Target, Range("B5")) Is Nothing Then
    Sheets("ТЛ").PrintOut From:=1, To:=2, Copies:=2
ElseIf Not Intersect(Target, Range("B6")) Is Nothing Then
    n = Fix(Val(Range("C4")))
    If n > 0 Then
    Sheets("ПП").PrintOut From:=1, To:=n
    End If
End If
End Sub
Изменено: МВВ МВВ - 08.03.2023 14:41:06
 
Перейти    
Макрос "печать ", Печать заданных листов и страниц
 
#
04.03.2023 20:27:44
Добрый день.
Требуется Ваша помощь.
Сам далек от VBA поэтому обращаюсь к Вам.
Есть желание оптимизировать процесс печати.
Требуется
1. Макрос "печати" условно на Листе1 "В5" - печатает одну страницу в двух экземплярах с Листа2 в прилагаемом файле лист "ТЛ"
2. Макрос "печати" на листе 1 "В6"- печатает страницы указанные в определенной ячейке "С4" на Листе1  с листа3 в одном экземпляре
 
Перейти    
запуск макроса клавишей ENTER, переход в определенную ячейку при нажатии ENTER
 
#
02.03.2023 17:41:05
Все работает. Большое Спасибо
 
Перейти    
запуск макроса клавишей ENTER, переход в определенную ячейку при нажатии ENTER
 
#
02.03.2023 10:45:50
Добрый день. Требуется Ваша помощь
имеется офис 360
В работе использую excel. Есть желание оптимизировать некоторые операции. Сам далек от VBA.
Требуется:
1. Автоматический запуск макроса при открытии книги
2. Последовательный переход в определенную ячейку после ввода данных и нажатия "ENTER" (в прилагаемом файле это А1,В2,С3 и обратно к А1)
3. После ввода данных и нажатия "ENTER" в последнюю ячейку курсор возвращается к первой ячейке

Все что смог найти более менее подходящее в сети это (Данный макрос срабатывает только при нажатии alt + enter):
в модуль листа 1
Private Sub Worksheet_Activate()
OnKey "~", "JmpNext"
End Sub

Private Sub Worksheet_Deactivate()
OnKey "~"
End Sub

В модуль книги
Sub JmpNext()
rnges = Array("$A$1", "$B$2", "$C$3")
j = -1
For i = 0 To UBound(rnges)
If rnges(i) = ActiveCell.Address Then
 j = i + 1
 Exit For
End If
Next i
If j > UBound(rnges) Then
j = 0
End If
If j > -1 Then
Range(rnges(j)).Select
Else
a = ActiveCell.Cells.Row
b = ActiveCell.Cells.Column
Cells(a + 1, b).Select
End If
End Sub
 
Перейти    
Страницы: 1
Наверх