VBA Excel :从特定单元格中搜索特定变量值的行,然后将值复制并粘贴到该列的宏

VBA Excel : Macro that searches a row for a certain variable value from specific cell and then copy&pastes value to this column

我过去做过一些 VBA 但就是找不到解决这个问题的方法。

我正在寻找一个宏,它在单元格 C4 到 Z4(从 C4 开始的无限长行)中搜索每周更改的单元格 B4 中的值(数字)。如果找到匹配项,则将单元格 B5 到 B100(从 B5 开始的无限长列)的值复制并粘贴到正确的 C 到 Z 列(从 C5 等向下)。

正确的列是指宏在 B4 和 C4 到 Z4 之间找到匹配项的列。 C4 到 Z4 不相同。

我搜索了很长时间,我能找到的最近的是: Macro that looks for a value in a cell & then paste a range in the column of that cell. EXCEL 2007

但是它对我不起作用。该线程中的解决方案表示匹配的单元格值应采用日期格式。我重建了所有这些,但即使使用日期而不是数字它也不起作用。宏总是根据 VBA 行

给出消息

MsgBox "Date Column for " & CStr([B2].Value) & “未找到”

所以它没有为我找到任何匹配项,即使我 运行 它在匹配单元格中具有相同的日期。 (我当然将此宏更改为我的单元格位置)

这个论坛是我最后的尝试:)

我的以下代码不起作用:

Private Sub CommandButton2_Click()

Dim ws As Worksheet
Dim rSrc As Range
Dim rDst As Range
Dim cl As Range
Dim dat As Variant

Set ws = ActiveSheet

' Get the Source range
Set rSrc = ws.Range([B5], ws.Columns(2).Cells(ws.Rows.Count, 1).End(xlUp))
dat = rSrc

' Find the Destination column and copy data
Set rDst = ws.Range([D4], ws.Rows(1).Cells(1, ws.Columns.Count).End(xlToLeft))
Set cl = rDst.Find(What:=[B4], _
  After:=rDst.Cells(1, 1), _
  LookIn:=xlValues, _
  LookAt:=xlWhole, _
  SearchOrder:=xlByRows, _
  SearchDirection:=xlNext)
If cl Is Nothing Then
    MsgBox "Column for " & CStr([B4].Value) & " Not Found"
Else
    Set rDst = cl.Offset(1, 0).Resize(UBound(dat, 1), 1)
    rDst = dat
End If

End Sub

谢谢。

此致

Sub FindandCopy
Dim what as range
dim where as range
dim found as range
set what = range("b4")  'what we're looking for
set where = range("c4")  'start of search range
do
if where = what then 
    set found = where  'that's where we found it
else
 set where = where.offset(0,1) 'otherwise keep looking
end if
loop until where = ""   'stop if blank
if found = "" then  'we fell off the end
      msgbox what & " not found "
else
      range(range("b5"),range("b5").end(xldown)).copy 
      found.offset(1,0).pastespecial xlpastevalues
end if
end sub