Копировать динамический диапазон - PullRequest
0 голосов
/ 17 октября 2019

Мне нужен код VBA для копирования динамического диапазона. Строки выглядят так:

R1 - Title
R2 - Headers
R3 - Data 
R97 - Data

R98 - Blank
R99 - Text
R100 - Title
R101 - Headers
R102 - Data

R150 - Blank
R151 - Text
R153 - Title
R153 - Headers
R154 - Data

У меня есть аналогичный набор данных в строках ниже. Я не могу фильтровать и копировать, потому что заголовок только в 2 ячейках и между ними пустые строки. Обратите внимание, что столбцы здесь являются статическими

Я ищу помощь для копирования данных в структурированном формате.

Я мог найти приведенный ниже код в другом диалоге, который копирует только 2 строки ниже заголовковно не игнорирует пробелы

Private Sub Search_n_Copy()

    Dim LastRow As Long
    Dim rng As Range, c As Range
    Dim vR(), n As Long, k As Integer, j As Integer
    Dim Ws As Worksheet

    With Worksheets("Trial Balance Detail") ' <-- here should be the Sheet's name
        '.Columns("e").ClearContents
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row in column A
        Set rng = .Range("B1:B" & LastRow) ' set the dynamic range to be searched

        ' loop through all cells in column A and copy below's cell to sheet "Output_2"
        For Each c In rng
            If c.Value = "Jrnl No." Then
                For j = 1 To 2
                    n = n + 1
                    ReDim Preserve vR(1 To 13, 1 To n)
                    For k = 1 To 13
                        vR(k, n) = c.Offset(j, k - 1) ' use offset to put value in sheet "Output_2", column E
                    Next k
                Next j
            End If
        Next c
        If n > 0 Then
            Set Ws = Sheets.Add '<~~~  Sheets("your sheet name")
            With Ws
                .Range("a1").Resize(n, 13) = WorksheetFunction.Transpose(vR)
            End With
        End If
    End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...