Благодарю!  

Не получается. Не видит снятие.

' Установите пароль
   password = "1" ' замените на нужный вам пароль
   
   ' Ссылка на текущую книгу
   Set wb = ThisWorkbook

   ' Сначала снимем защиту с книги
   wb.Unprotect password

Есть три листа, которые пользователь заполняет в качестве формы. Пусть это будет Лист1 Лист2 Лист3. Макрос из них собирает данные и формирует Лист4. Пользователь лист печатает. Затем Макрос2 Очищает ячейки для заполнения и удаляет Лист 4. Поэтому книгу не защитить, макросы работать на создание и удаление листа не будут. Как быть? Может можно кнопку "Удалить лист" скрыть от кривых рук?))  

BodkhiSatva, спасибо большое! Особенно за то что подробно расписали!  

BodkhiSatva, представьте принтера нет, баллы заранее знать нельзя. А макрос для отчета уже существует как раз. В этом вся загвостка.  

Hugo, а если в листах есть макросы? А листы можно скрыть?

Здравствуйте, коллеги!
Ситуация такова.
Нужна подсказка, как организовать движение данных, если первоначальные данные заполняются в файле "старт", а потом должны храниться в книге с подготовленным шаблоном.
Поясню на примере (файлы придуманы, но суть отражают).
1. Администратор заполняет файл старт. Нажимает кнопку "Загрузить данные".
2. Администратор выбирает папку, в которой создается новая книга, которая называется по ФИО. Но книга не пустая, там уже заготовлены листы для выставления оценок.
3. Затем участник ходит к одному эксперту за раз. (Файл не может быть открыт двумя людьми одновременно), которые страницы заполняют.

+ надо учесть что для разного возраста разный шаблон

Как это вижу я:
0. Макрос считывает ячейку возраст
1. Предлагает пользователю выбрать папку
2. Макрос копирует нужный файл "Шаблон" из папки к которой прописан путь
3. Вставляет его в выбранную папку
4. Переименовывает
5. Открывает
6. Переносит нужные данные

Но хочу услышать ваши видение, может есть более эффективный способ  

Добрый день участники форума! Вопрос следующий.
У нас есть справки, которые могут занимать от 1/4 до 1/2 части листа А4.
Есть листы в книге (Лист1 - заполняем информацию о сотруднике, Лист2 - данные вставляются в справки). На листе 2 эти справки оптимизированы по размеру. При печати выдается 4 листа А4. Но бывает так, что 2-3 справки печатать не нужно.
Возможно ли создать макрос который будет убирать не нужные справки? (Если на Листе1 выбирается например да/нет). Я уже не говорю про оптимизацию размеров, просто убирались, чтобы краску в принтере экономить.
Сама еще не пробовала написать, так как хочу узнать, возможно ли такое сделать? Может написать код, где (Если в ячейки А2 "нет", то поле В1:F14 покрасить в белый).
Заранее спасибо.
Файл прикрепить не могу исходя из документа о неразглашении.  

Такая задача. Заполняется ячейка "курит ли человек", если "нет2, то в ячейке "кол-во выкуренных сигарет" автоматически будет "0", а можно ли сделать так, чтобы при ответе "да", ячейка оставалась пустой, а "кол-во" вводилось руками?  

Товарищи! Спасайте!
На работе есть парйс лист. В листе есть разделы "Бахилы" "Бинты" "Иглы". Они содержат код имя и цены
Начальство хочет разбить лист на отдельные листы. Но! С сохранением общего прайса.
Цены меняются каждый день и добавляются позиции.
Как сделала я:
1. Сделала именованные диапазоны
2. С помощью Power Query получила данные и создала три листа.
Вроде отлично, меняем цену в прайсе и добавляем розовые бахилы всё переносится на отдельные листы.
НО! Повер Кьюри создаёт фильтрацию на каждый диапазон. И получается на одном листе много фильтрованных таблиц. А они хотят по алфавиту весь прайс!! Решение найти не могу((((  

Ігор Гончаренко, ну хорошо. Попробую так, как вы сказали    

Открыта Книга 1
Открыта книга 2
В книге 1 кнопочка, которую надо нажать
Если в книге 1 пустая ячейка F4, в книге 2 надо во всех листах очистить столбцы F

Проблема: Путь к Книге 2 неизвестен. Как связать книги?  

Доброе утро, столкнулась с проблемой. Есть макрос который смотрит пустая ли ячейка Ф, если да, чистит все столбцы Ф во второй книге. Но! Вторая книга каждым сотрудником сохраняется в разном месте. Если вторая будет в ней можно будет работать или нет? Вот код. Уже совсем не знаю, что делать  


 
' Установим активным лист "Создать прайс" в текущей рабочей книге
   Set wsCurrent = ThisWorkbook.Sheets("Создать прайс")

   ' Проверим, является ли ячейка F4 пустой
   If wsCurrent.Cells(4, "F").Value = "" Then
       ' Если ячейка F4 пуста, то откроем внешнюю книгу
       Set ExternalWorkbook = Workbooks("Клиентский прайс.xlsx")
       
       
       ' Перебираем каждый лист во внешней книге и удаляем столбец F
       For Each ws In ExternalWorkbook.Sheets
           ' Определяем последнюю заполненную строку в столбце F
           LastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
           
           ' Удаляем столбец F
           ws.Columns("F:F").Clear
       Next ws
   End If

Добрый день!
Задача такая.
В рабочей книге1 два макроса. Первый макрос делает копию листов в Книгу "Прайсы для клиентов". А второй должен просмотреть в Книге1 диапазон  F4:R4 на листе  "Создать прайс". И если есть пустые ячейки удалить все столбцы в Книге "прайсы для клиентов" на ту же букву (Если H4 и I4 пусто, удаляем столбецы Н и I)

Грубо говоря я запуталась с циклом IF
Буду рада любой помощи

Sub УдалитьПустыеСтолбцы()
   Dim wsSource As Worksheet
   Dim wsTarget As Worksheet
   Dim col As Long
   Dim lastCol As Long
   Dim wbTarget As Workbook
   
   ' Укажите лист "Создать прайс" в текущей книге
   Set wsSource = ThisWorkbook.Sheets("Создать прайс")
   
   ' Откройте книгу "Прайсы для клиентов" (предположим, что она уже открыта)
   ' и укажите книгу как объект wbTarget
   Set wbTarget = Workbooks("Прайсы для клиентов.xlsx") ' Замените на соответствующее имя книги
   
   ' Определите последний столбец в диапазоне
   lastCol = wsSource.Cells(4, wsSource.Columns.Count).End(xlToLeft).Column
   
   ' Перебирайте столбцы справа налево, чтобы избежать смещения при удалении столбцов
   For col = lastCol To 6 Step -1 ' 6 соответствует столбцу F
       
       ' Проверьте, есть ли пустые ячейки в столбце
       If WorksheetFunction.CountBlank(ThisWorkbook.Sheets("Создать прайс").Range("F4:R4")) > 0 Then
           ' Переберите все листы в целевой книге
           For Each wsTarget In wbTarget.Sheets
               ' Удалите столбец в каждом листе
               wsTarget.Cells(4, col).EntireColumn.Delete
           Next wsTarget
       End If
   Next col
   
   ' Сообщение об окончании выполнения
   MsgBox "Пустые столбцы удалены в книге 'Прайсы для клиентов.xlsx'."
End Sub

Ігор Гончаренко, а вы не смотрели код. Я просто не понимаю в какую часть запихнуть, то что вы написали)) Тяжело мне даётся ВБА)

Ігор Гончаренко Спасибо. Это вставлять в цикл с ЕСЛИ?

Экс-экс-экс, держите, только я макрос очистила, пытаюсь другое решение найти  

Sub КопироватьЛистыВНовуюКнижечку()
   Dim wbSource As Workbook
   Dim wbNew As Workbook
   Dim wsSource As Worksheet
   Dim cell As Range
   Dim sheetName As String
   
   ' Укажите текущую книгу, из которой нужно копировать листы
   Set wbSource = ThisWorkbook
   
   ' Создайте новую книгу
   Set wbNew = Workbooks.Add
   
   ' Переименуйте новую книгу
   wbNew.SaveAs "C:\Users\Мирочка\Downloads\Прайсы для клиентов.xlsx"

   
   ' Перейдите к листу "Создать прайс" в текущей книге
   Set wsSource = wbSource.Sheets("Создать прайс")
   
   ' Пройдитесь по диапазону C3:C25
   For Each cell In wsSource.Range("C3:C25")
       sheetName = cell.Value
       
       ' Проверьте, существует ли такой лист в текущей книге
       If WorksheetExists(sheetName, wbSource) Then
           ' Копируйте лист в новую книгу
       wbSource.Sheets(sheetName).Copy Before:=wbNew.Sheets(1)
       wbNew.Sheets(1).Cells.Clear
       wbSource.Sheets(sheetName).Range("A2:E100").Copy wbNew.Sheets(1).Cells(1, 1)

       End If
   Next cell
   

   ' Проверяем критерии в ячейке F4 и копируем соответствующие столбцы
   If wsSource.Cells(4, "F").Value <> "" Then
       wsSource.Columns("F").Copy
   ElseIf wsSource.Cells(4, "G").Value <> "" Then
       wsSource.Columns("G").Copy
   ElseIf wsSource.Cells(4, "H").Value <> "" Then
       wsSource.Columns("H").Copy
   ElseIf wsSource.Cells(4, "I").Value <> "" Then
       wsSource.Columns("I").Copy
   ElseIf wsSource.Cells(4, "J").Value <> "" Then
       wsSource.Columns("J").Copy
   ElseIf wsSource.Cells(4, "K").Value <> "" Then
       wsSource.Columns("K").Copy
   ElseIf wsSource.Cells(4, "L").Value <> "" Then
       wsSource.Columns("L").Copy
   ElseIf wsSource.Cells(4, "M").Value <> "" Then
       wsSource.Columns("M").Copy
   ElseIf wsSource.Cells(4, "N").Value <> "" Then
       wsSource.Columns("N").Copy
   ElseIf wsSource.Cells(4, "O").Value <> "" Then
      wsSource.Columns("O").Copy
   ElseIf wsSource.Cells(4, "P").Value <> "" Then
       wsSource.Columns("P").Copy
   ElseIf wsSource.Cells(4, "Q").Value <> "" Then
       wsSource.Columns("Q").Copy
   ElseIf wsSource.Cells(4, "R").Value <> "" Then
       wsSource.Columns("R").Copy
   Else
       MsgBox "Ни один критерий не заполнен в ячейке F4."
       Exit Sub
   End If
   
   ' Вставляем скопированные столбцы в нужное место (например, столбец A)
  wbSource.Sheets(sheetName).Cells(F2).PasteSpecial Paste:=xlPasteValues
   
   ' Очищаем буфер обмена
   Application.CutCopyMode = False
   
   ' Сообщение об окончании выполнения
   MsgBox "Листы скопированы в новую книгу 'Прайсы для клиентов.xlsx'."
End Sub

Function WorksheetExists(ByVal wsName As String, ByVal wb As Workbook) As Boolean
   ' Проверьте, существует ли лист с заданным именем в указанной книге
   On Error Resume Next
   WorksheetExists = Not wb.Sheets(wsName) Is Nothing
   On Error GoTo 0
End Function

Пишу код на ВБА. Условие такое
В диапазоне есть имена листов (содержащихся в Книге1)
Надо перенести в Книгу2 ( Каждый лист на новом листе)
По умолчанию всегда переносится диапазон A2:E100
Но с F по R есть колонки, которые нужно переносить выборочно
Условие к их переносу заполнение на стартовом листе ячейку F4-R4
НО проблема, запуталась как прописать им путь и как сделать так чтобы если я копировала НЕ соседние колонки они встали рядом. Код оставлю ниже.
Ошибку выдают вот на этой строке
:Вставляем скопированные столбцы в нужное место (например, столбец A)
  wbSource.Sheets(sheetName).Cells(F2).PasteSpecial Paste:=xlPasteValues

Дмитрий(The_Prist) Щербаков, Спасибо!! Прекрасно работает

webley, выдаёт ошибку  

Полный код:

Sub КопироватьЛистыВНовуюКнигу()
   Dim wbSource As Workbook
   Dim wbNew As Workbook
   Dim wsSource As Worksheet
   Dim cell As Range
   Dim sheetName As String
   
   ' Укажите текущую книгу, из которой нужно копировать листы
   Set wbSource = ThisWorkbook
   
   ' Создайте новую книгу
   Set wbNew = Workbooks.Add
   
   ' Переименуйте новую книгу
   wbNew.SaveAs "C:\Users\User\Downloads\Прайсы для клиентов.xlsx"

   
   ' Перейдите к листу "Создать прайс" в текущей книге
   Set wsSource = wbSource.Sheets("Создать прайс")
   
   ' Пройдитесь по диапазону C3:C25
   For Each cell In wsSource.Range("C3:C25")
       sheetName = cell.Value
       
       ' Проверьте, существует ли такой лист в текущей книге
       If WorksheetExists(sheetName, wbSource) Then
           ' Копируйте лист в новую книгу
           wbSource.Sheets(sheetName).Copy Before:=wbNew.Sheets(1)
       End If
   Next cell
   
   ' Закройте новую книгу, сохраните изменения
   wbNew.Close SaveChanges:=True
   
   ' Сообщение об окончании выполнения
   MsgBox "Листы скопированы в новую книгу 'Прайсы для клиентов.xlsx'."
End Sub

Function WorksheetExists(ByVal wsName As String, ByVal wb As Workbook) As Boolean
   ' Проверьте, существует ли лист с заданным именем в указанной книге
   On Error Resume Next
   WorksheetExists = Not wb.Sheets(wsName) Is Nothing
   On Error GoTo 0
End Function

Доброго времени суток, проблема следующая.
Ниже оставлю код.

Задача была поставлена такая: менеджер в столбике пишет имена листов и нажимает на кнопочку. Макрос выбранные менеджером листы копируют в новую книгу. Но! Нужно не весь лист скопировать, а только диапазон (A2:E100)

Если в коде писать:   wbSource.Sheets(sheetName).Copy Before:=wbNew.Sheets(1)
То всё ок
Но если сделать так:   wbSource.Sheets(sheetName).Range(A2:E100).Copy Before:=wbNew.Sheets(1)
Выдаёт ошибку((
Как исправить?  

Maximich, там есть товары, а есть заголовки, но после заголовков был пробел, вот эксель и терялся

Дмитрий(The_Prist) Щербаков, Спасибо! Проблема оказалось действительно просто в пробеле!  

Maximich,  

Maximich, да пример есть. Вот общий прайс и второй лист где данные дублируются. Часть таблиц пришлось удалить, не влезает по размеру

Здравствуйте,
С помощью надстройки Power Query Скопировала часть таблицы на новый лист. Просто залить Ячейку через "Главная" получается. Но мы постоянно меняем данные, и ячейка ( точнее её текст) которые нужно выделять перемещаются по строкам, заливка сбивается. Пробовала через "Условное форматирование" тоже не выделяет (Ни с помощью "Задать условие", ни с помощью "Равно").
Я даже написала макрос! И он несчастный на это листе тоже не работает, хотя, если создать лист без запроса и запустить макрос, свои функции выполняет.
Я не знаю что делать( Неужели нет решения данной проблемы?