Я пишу макрос для 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