Всем привет, у меня есть такая потребность, создание папок и подпапок  1 столбец это главная папка, 2 столбец это подпапки. Но код не совсем работает  Sub CreateFoldersAndSubfoldersWithUserInput()
'Updateby Extendoffice
   Dim Rng As Range
   Dim Cell As Range
   Dim basePath As String
   Dim fldrPicker As FileDialog
   Dim FolderPath As String, subfolderPath As String
   On Error Resume Next
   Set Rng = Application.InputBox("Select the range of cells (two columns: one is folder column, another s subfolder column):", "Kutools for Excel", Type:=8)
   If Rng Is Nothing Then Exit Sub
   On Error GoTo 0
   Set fldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
   With fldrPicker
       .Title = "Select the Base Folder Path"
       .AllowMultiSelect = False
       If .Show <> -1 Then Exit Sub
       basePath = .SelectedItems(1)
   End With
   If Right(basePath, 1) <> "\" Then basePath = basePath & "\"
   For Each Cell In Rng.Columns(1).Cells
       If Not Cell.Value = "" Then
           FolderPath = basePath & Cell.Value
           If Not FolderExists(FolderPath) Then MkDir FolderPath
           If Not Cell.Offset(0, 1).Value = "" Then
               subfolderPath = FolderPath & "\" & Cell.Offset(0, 1).Value
               If Not FolderExists(subfolderPath) Then MkDir subfolderPath
           End If
       End If
   Next Cell
End Sub

Function FolderExists(FolderPath As String) As Boolean
   On Error Resume Next
   FolderExists = (GetAttr(FolderPath) And vbDirectory) = vbDirectory
   On Error GoTo 0
End Function

Всем добрый день! Прошу помочь мне избавиться от муторного дела — копирования сводных таблиц и превращения их в обычные. Я очень часто пользуюсь сводными таблицами, но мне нужно постоянно преобразовывать их в обычные. Я копирую сводную таблицу, исключая итоговую строку, и затем вставляю её, только так я могу избавиться от сводной. Может быть, есть макрос, который возьмёт все сводные таблицы в открытой книге и сделает их обычными? этот макрос не работает..

Sub ConvertPivotTablesToValues()
   Dim ws As Worksheet
   Dim pt As PivotTable
   Dim finalRange As Range
   
   ' Проходим по каждой вкладке в книге
   For Each ws In ThisWorkbook.Worksheets
       ' Проходим по каждой сводной таблице на листе
       For Each pt In ws.PivotTables
           ' Копируем данные сводной таблицы
           pt.TableRange2.Copy
           
           ' Вставляем как значения
           Set finalRange = pt.TableRange2.Cells(1, 1)
           finalRange.PasteSpecial Paste:=xlPasteValues
           
           ' Очистка буфера обмена
           Application.CutCopyMode = False
       Next pt
   Next ws
   
   MsgBox "Все сводные таблицы были успешно преобразованы в обычные значения!"
End Sub

Добрый день, прошу исправить макрос, который группирует строки с жирным цветом, а вот эти не группирует


Sub GroupByBoldAndNonBold()
   Dim iLastRow As Long, lStart As Long
   Dim i As Long
   Application.ScreenUpdating = False
   
   ' Определяем последнюю строку с данными в первом столбце
   iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
   lStart = 1
   
   ' Проходим по всем строкам до последней
   For i = 1 To iLastRow
       If Cells(i, 1).Font.Bold Then
           ' Если встречаем жирную строку и lStart меньше текущей строки
           If lStart < i Then
               ' Группируем нежирные строки между жирными
               Range(Cells(lStart, 1), Cells(i - 1, 1)).EntireRow.Group
           End If
           ' Обновляем lStart на следующую строку после жирной
           lStart = i + 1
       End If
   Next i
   
   ' Проверяем, есть ли нежирные строки после последней жирной строки
   If lStart <= iLastRow Then
       Range(Cells(lStart, 1), Cells(iLastRow, 1)).EntireRow.Group
   End If
   
   Application.ScreenUpdating = True
End Sub

Всем, доброе утро!! Прошу исправить код, он не работает со всеми листами книги, а только с активным.
Sub ОбъединенныйМакрос()
   ' Вызов первой части макроса для форматирования ячеек
   Call OptimizeMacro
   
   ' Вызов второй части макроса для удаления пустых строк и столбцов
   Call Удаление_пустых_строк_столбцов_обычная
End Sub

Sub OptimizeMacro()
   With ActiveSheet.UsedRange
       .HorizontalAlignment = xlGeneral
       .VerticalAlignment = xlTop
       .WrapText = False
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   With Selection
       .HorizontalAlignment = xlGeneral
       .VerticalAlignment = xlTop
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
End Sub

Sub Удаление_пустых_строк_столбцов_обычная()
   Dim ws As Worksheet
   Dim rng As Range
   Dim r As Long, c As Long

   Set ws = ActiveSheet

   ' Удаление пустых строк
   For r = ws.UsedRange.Rows.Count To 1 Step -1
       If Application.WorksheetFunction.CountA(ws.Rows®) = 0 Then
           If rng Is Nothing Then
               Set rng = ws.Rows®
           Else
               Set rng = Union(rng, ws.Rows®)
           End If
       End If
   Next r
   If Not rng Is Nothing Then rng.Delete

   Set rng = Nothing

   ' Удаление пустых столбцов
   For c = ws.UsedRange.Columns.Count To 1 Step -1
       If Application.WorksheetFunction.CountA(ws.Columns©) = 0 Then
           If rng Is Nothing Then
               Set rng = ws.Columns©
           Else
               Set rng = Union(rng, ws.Columns©)
           End If
       End If
   Next c
   If Not rng Is Nothing Then rng.Delete

   MsgBox "Удаление пустых строк и столбцов завершено!"
End Sub

Можно написать макрос, чтобы он был полезен для очистки данных, если нужно удалить строки, когда в выделенном диапазоне содержатся пустые значения, кроме первой строки.

Прошу помочь настроить визуализацию план-факта

Доброе утро, прошу мне помочь. Как посчитать сколько месяцев на выполнение работ между 1 и 2 этапом ,между 2 и 3 этапом?

Всем добрый день, хочу поделиться своей проблемой. Если из Power Pivot стоить диаграммы, а затем их копировать, то возникает ошибка .А затем ексель просто завершает работу, при этом не сохраняет данные. У меня вопрос вот в чем, может только диаграммы, созданные из сводной таблицы копируются несколько раз? А из Power Pivot только должен быть оригинал, или у меня что-то настройками...подскажите мне как быть в этой ситуации?

Добрый день, меня давно мучает вопрос, как убрать это слово (пусто). Есть сводная таблица, которая формируется из Модель данных.

Всем доброе утро, прошу мне помочь в написании макроса. У меня есть 2 выгрузки (новая и старая),которые надо сравнить.
1. Надо выделить диапазон из новой выгрузки и выделить диапазон из старой выгрузки.
2. результат сравнения перенести на соседний лист.

Доброе утро. Помогите, пожалуйста, решить такую задачу. Данные выгружаются из 1С, потом обрабатываются в PQ в конечном варианте представляются  на листе в Екселе в виде сводной таблицы и просто таблиц с данными. Моя задача, чтобы эти таблицы с данными и  с исходным форматированием перенеслись в Ворд (на новый документ). После того как они перенеслись в ворд, надо что таблицы встали по размеру содержимого или по размеру листа.

Добрый день. Я собираю данные в сводную таблицу из Квери и Пивот, но для того чтобы потом ее редактировать, мне приходится выделять диапазон, копировать и вставлять как значения… я уже просто намучилась. Может есть макрос, который скопирует ее на отдельный файл или лист и превратит ее в значения, чтобы я потом могла удалять цифры..Если кто-то знает, напишите.  

Всем здравствуйте, помогите, пожалуйста, мне надо после обработки табеля, разделить столбец на строки и  сократить инициалы ФИО. Заранее спасибо.

Добрый день, напишите, пожалуйста, макрос, чтобы при открывании файла отображались скрытые строки и столбцы. Sub Отобразить скрытые строки и столбцы()Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
End Sub    Нашла только к листу

Прошу помочь автоматизировать форматирование отчета, выгрузка идет из 1С, всегда разное кол-во строк. Надо удалить пустые столбцы со сдвигом влево, но обычным макросом, это невозможно, так как в каждой таблице значения в разных столбцах.