VBA: копировать только значения для выбранного столбца в диапазоне, но копировать формулы для остальных столбцов - PullRequest
0 голосов
/ 04 февраля 2020

Я пишу макрос для l oop через все листы в моей книге и копирую диапазон ячеек из каждого листа в лист назначения. Это работает, как задумано, но с незначительной проблемой. Я хотел бы скопировать и вставить формулы для столбцов B: AD в выбранном диапазоне, но ТОЛЬКО КОПИРОВАТЬ ВСТАВИТЬ значения для столбца A. Поэтому, по сути, я хочу скопировать только значения для столбца A, но формулы для остальной части диапазона. В настоящее время код копирует формулы для всех столбцов, что вызывает проблему на рабочем листе назначения.

В основном значение в столбце A является абсолютной ссылкой на ячейку B3 ($ B $ 3). Поэтому, когда я копирую диапазон на лист назначения, значение в столбце A не заполняется. Если есть более простой способ решить эту проблему, чем идея, что я должен копировать только значения, я полностью открыт для него.

Код работает без ошибок, но я застрял на том, как свершившийся sh этот последний кусок. Любая помощь будет оценена.

Sub CopyAllWorksheetsToSummary()

'Define dims
    Dim wks As Worksheet
    Dim FirstRow As Long
    Dim LastRow As Long
    Dim StartRow As String
    Dim EndRow As String
    Dim Rng As Range
    Dim Count As Long

'Loop through and copy all worksheets excluding ones specified to the Summary sheet
    For Each wks In ThisWorkbook.Worksheets
        If Not wks.Name = "SUMMARY TEMPLATE" _
        And Not wks.Name = "PROJECT TEMPLATE" Then
            With wks
            LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row - 1
        End With

'Find cell in column A that has the word "Task", and start two rows below it
        For Count = 1 To LastRow
            If (Range("A" & Count).Value = "Task") Then
                FirstRow = Count + 2
            End If
        Next Count

'Define range to copy and destination range to copy to, append to end of sheet
        wks.Range("A" & FirstRow & ":AD" & LastRow).COPY _
        Destination:=Worksheets("SUMMARY TEMPLATE").Cells(Rows.Count, "A").End(xlUp).Offset(1)
    End If
    Next

'Set Active Worksheet to the Summary sheet and remove duplicates
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Sheets("SUMMARY TEMPLATE")
    ws.Range("A10:AD" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).RemoveDuplicates Columns:=Array(1, 2, 3)

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