Выбор поля в макросе и вырезание его в цикле

Мне нужно выбрать поле ячеек (таблицы) на листе Excel, вырезать выделение, а затем вставить его в новый отдельный лист. В этом листе таблички ниже, чем тысячи, и я хочу, чтобы они автоматически вырезали их и вставляли их в отдельные листы. Таблицы разделены ячейками с # символом внутри, но я не знаю, насколько это полезно в любом случае. Когда я записал этот макрос для первой таблицы, он работает следующим образом:

Sub Makro1() Range("A2:AB20").Select Selection.Cut Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Paste End Sub 

Теперь я хочу сделать цикл, который будет проходить через весь рабочий лист, динамически выбирать каждую таблицу, которая будет ограничена знаком # в столбце A и вставить его в новый лист. Я не хочу выбирать точный диапазон A2: AB20, но я хочу сделать выбор в соответствии с этим знаком #.

Вот скриншот введите описание изображения здесь

Попробуйте этот код. Возможно, вам потребуется настроить верхние 4 константы в соответствии с вашими потребностями:

 Sub CopyToSheets() Const cStrSourceSheet As String = "tabulky" Const cStrStartAddress As String = "A2" Const cStrSheetNamePrefix As String = "Result" Const cStrDivider As String = "#" Dim rngSource As Range Dim lngMaxRow As Long, lngLastDividerRow As Long, lngRowCount As Long Dim wsTarget As Worksheet Dim lngCounter As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'Delete old worksheets Application.DisplayAlerts = False For Each wsTarget In Sheets If InStr(wsTarget.Name, cStrSheetNamePrefix) Then wsTarget.Delete Next Application.DisplayAlerts = True With Sheets(cStrSourceSheet) Set rngSource = .Range(cStrStartAddress) lngLastDividerRow = rngSource.Row lngMaxRow = .Cells(Rows.Count, 1).End(xlUp).Row End With Set rngSource = rngSource.Offset(1) While rngSource.Row < lngMaxRow If rngSource = cStrDivider Then lngCounter = lngCounter + 1 Set wsTarget = Sheets.Add(After:=Sheets(Sheets.Count)) wsTarget.Name = cStrSheetNamePrefix & " " & lngCounter lngRowCount = rngSource.Row - lngLastDividerRow - 1 rngSource.Offset(-lngRowCount - 1).Resize(lngRowCount).EntireRow.Copy _ wsTarget.Range("A1").Resize(lngRowCount).EntireRow lngLastDividerRow = rngSource.Row End If Set rngSource = rngSource.Offset(1) Wend Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 

Это заполнит массив указателями всех ваших хэш-значений. Это должно предоставить вам ориентир, необходимый для сбора соответствующих данных.

 Sub FindHashmarksInColumnA() Dim c As Range Dim indices() As Long Dim i As Long Dim iMax As Double Dim ws As Worksheet Set ws = ActiveSheet i = 0 iMax = Application.WorksheetFunction.CountIf(ws.Range("A:A"), "#") ReDim indices(1 To iMax) For Each c In ws.UsedRange.Columns(1).Cells If c.Value = "#" Then i = i + 1 indices(i) = c.Row End If Next c ' For each index, ' Count rows in table, ' Copy data offset from reference of hashmark, ' Paste onto new sheet in appropriate location etc. End Sub 
Interesting Posts

Как извлечь уникальные значения из двух столбцов Excel VBA

Читайте китайский язык при экспорте в excel

Найдите столбец, который соответствует критериям и скопируйте другие ячейки в этой строке на новый лист

Как закончить закрытие открытого файла excel при ошибке?

Как передать значение ячейки в excel в формулу

Автоматизация Excel с помощью Visual Studio

умножая много столбцов только на один столбец

Copy-PasteSpecial не работает на больших диапазонах

Как установить проверенное свойство в vba (формат или панель инструментов управления)

Неверное распознавание формата временной метки Excel

= функция фильтрации для Excel, как в таблицах Google?

Python – использование win32com.client для форматирования диапазона ячеек Excell в качестве таблицы

Импорт нескольких строк из sql с использованием определенных значений

Excel перечисляет именованный диапазон в листе и получает значение

Как добавить конечный ноль в строку с c #?

Давайте будем гением компьютера.