我正在寻找Excel的VBA代码,它将在一个工作表中循环遍历一列数字(条形码),在另一个工作表(同一工作簿)上查找每个数字(条形码)的完全匹配,然后复制整行到输入搜索词编号(条形码)旁边的列中的原始工作表 .
我找到了这段代码,但它没有遍历工作表中的数字列(条形码)(搜索词) . 搜索范围应该是包含所有数据的整个工作表 .
Sub Copy()
Dim objWorksheet As Worksheet
Dim rngBurnDown As Range
Dim rngCell As Range
Dim strPasteToSheet As String
'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range
'Define the worksheet with our data
Set objWorksheet = ActiveWorkbook.Sheets("Burn Down")
'Dynamically define the range to the last cell.
'This doesn't include and error handling e.g. null cells
'If we are not starting in A1, then change as appropriate
Set rngBurnDown = objWorksheet.Range("A3:A" & objWorksheet.Cells(Rows.Count, "A").End(xlUp).Row)
'Now loop through all the cells in the range
For Each rngCell In rngBurnDown.Cells
objWorksheet.Select
If rngCell.Value <> "" Then
'select the entire row
rngCell.EntireRow.Select
'copy the selection
Selection.Copy
'Now identify and select the new sheet to paste into
Set objNewSheet = ActiveWorkbook.Sheets("Burn Down " & rngCell.Value)
objNewSheet.Select
'Looking at your initial question, I believe you are trying to find the next available row
Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)
'MsgBox "Success"
objNewSheet.Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
ActiveSheet.Paste
End If
Next rngCell
objWorksheet.Select
objWorksheet.Cells(1, 1).Select
End Sub
1 回答
并且应该被称为
发布此答案而不进行测试 .