Я нашел этот код в Google и пытаюсь заставить его работать на меня. Vlookup для копирования цвета ячейки - Excel VBA
У меня есть книга Excel, в которой я хочу легко VLOOKUP значения и форматирование из листа Excel, который я сделал неделю назад.
Я могу скачать список из нашей базы данных с ценами.Затем вручную добавляется цена от / до в ячейки.Это происходит каждую неделю.Мне приходится копировать и вставлять вручную каждую неделю, потому что VLOOKUP не добавляет форматирование.
Вот как выглядит источник (oud): 
My VLOOKUP возвращает значения правильно, я просто хочу форматирование.
=VLOOKUP(A2;oud!A:D;4;FALSE)
Не могу получить ранее упомянутый макрос по ссылке для работы.Я довольно новичок в VBA, поэтому относитесь ко мне как к новичку;)
Кто-нибудь может помочь?Это сэкономило бы мне много времени каждую неделю:)
Option Explicit
' By StackOverflow user LondonRob
' See http://stackoverflow.com/questions/22151426/vlookup-to-copy-color-of-a-cell-excel-vba
Public Sub formatSelectionByLookup()
' Select the range you'd like to format then
' run this macro
copyLookupFormatting Selection
End Sub
Private Sub copyLookupFormatting(destRange As Range)
' Take each cell in destRange and copy the formatting
' from the destination cell (either itself or
' the vlookup target if the cell is a vlookup)
Dim destCell As Range
Dim srcCell As Range
For Each destCell In destRange
Set srcCell = getDestCell(destCell)
copyFormatting destCell, srcCell
Next destCell
End Sub
Private Sub copyFormatting(destCell As Range, srcCell As Range)
' Copy the formatting of srcCell into destCell
' This can be extended to include, e.g. borders
destCell.Font.Color = srcCell.Font.Color
destCell.Font.Bold = srcCell.Font.Bold
destCell.Font.Size = srcCell.Font.Size
destCell.Interior.Color = srcCell.Interior.Color
End Sub
Private Function getDestCell(fromCell As Range) As Range
' If fromCell is a vlookup, return the cell
' pointed at by the vlookup. Otherwise return the
' cell itself.
Dim srcColNum As Integer
Dim srcRowNum As Integer
Dim srcRange As Range
Dim srcCol As Range
srcColNum = extractLookupColNum(fromCell)
Set srcRange = extractDestRange(fromCell)
Set srcCol = getNthColumn(srcRange, srcColNum)
srcRowNum = Application.Match(fromCell.Value, srcCol, 0)
Set getDestCell = srcRange.Cells(srcRowNum, srcColNum)
End Function
Private Function extractDestRange(fromCell As Range) As Range
' Get the destination range of a vlookup in the formulat
' of fromCell. Returns fromCell itself if no vlookup is
' detected.
Dim fromFormula As String
Dim startPos As Integer
Dim endPos As Integer
Dim destAddr As String
fromFormula = fromCell.Formula
If Left(fromFormula, 9) = "=VLOOKUP(" Then
startPos = InStr(fromFormula, ",") + 1
endPos = InStr(startPos, fromFormula, ",")
destAddr = Trim(Mid(fromFormula, startPos, endPos - startPos))
Else
destAddr = fromCell.Address
End If
Set extractDestRange = fromCell.Parent.Range(destAddr)
End Function
Private Function extractLookupColNum(fromCell As Range) As Integer
' If fromCell contains a vlookup, return the number of the
' column requested by the vlookup. Otherwise return 1
Dim fromFormula As String
Dim startPos As Integer
Dim endPos As Integer
Dim colNumber As String
fromFormula = fromCell.Formula
If Left(fromFormula, 9) = "=VLOOKUP(" Then
startPos = InStr(InStr(fromFormula, ",") + 1, fromFormula, ",") + 1
endPos = InStr(startPos, fromFormula, ",")
If endPos < startPos Then
endPos = InStr(startPos, fromFormula, ")")
End If
colNumber = Trim(Mid(fromFormula, startPos, endPos - startPos))
Else
colNumber = 1
End If
extractLookupColNum = colNumber
End Function
Private Function getNthColumn(fromRange As Range, n As Integer) As Range
' Get the Nth column from fromRange
Dim startCell As Range
Dim endCell As Range
Set startCell = fromRange(1).Offset(0, n - 1)
Set endCell = startCell.End(xlDown)
Set getNthColumn = Range(startCell, endCell)
End Function
Я скопировал код, вставленный в лист макроса.В мою книгу добавлена кнопка, которая связана с макросом.Выбрал диапазон столбца чистой цены, где у меня есть vlookup.Затем я нажимаю кнопку и получаю эту ошибку, которая приводит к:
Set extractDestRange = fromCell.Parent.Range(destAddr)
ошибка времени выполнения '1004': ошибка, определяемая приложением или объектом *