Excel VBA:查找数据、遍历多个工作表、复制特定范围的单元格
Excel VBA:查找数据、遍历多个工作表、复制特定范围的单元格
提问于 2015-08-27 00:29:33
我正在为一个将要分发给一组人员的文件创建一个宏；该函数应该能够从另一个单元格(在变量B中)中拉出该人的姓名，在具有多个工作表(变量X)的另一个工作簿中搜索该值，如果找到，则将特定范围的单元格从工作簿X复制到工作簿B。
我在使用以下代码时遇到了问题：
Sub Pull_data_Click()
Dim A As Variant 'defines name from first subroutine
Dim B As Workbook 'defines destination file
Dim X As Workbook 'defines existing report file as source
Dim Destination As Range 'defines destination range of data pulled from report
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
A = Workbooks("filenameB.xlsm").Worksheets("Summary").Range("A1").Value 'constant variable, does not change
Set B = Workbooks("filenameB.xlsm") 'constant variable, does not change
Set X = Workbooks.Open("filenameX.xlsm") 'dependent variable, new name for each new report
Set Destination = Workbooks("filenameB.xlsm").Worksheets("Input").Range("B2:S2") 'Range changes for each iteration, rows increase by 1
'check if name is entered
If A = "" Then
MsgBox ("Your name is not visible; please start from the Reference tab.")
B.Worksheets("Reference").Activate
Exit Sub
End If
With X.Worksheets
For Each ws In X.Worksheets
Set rng = Cells.Find(What:=A, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
ActiveCell.Activate
ActiveSheet.Range("$A$2:$DQ$11").AutoFilter Field:=1, Criteria1:=A
Range("A7:CD7").Select
Selection.Copy
B.Activate
Destination.Activate
Destination.PasteSpecial Paste:=xlPasteValues
Next ws
End With
Application.ScreenUpdating = False
End Sub它能够成功编译并且没有运行时错误，并且当它运行时，它似乎在工作表correctly...but中循环，它粘贴了错误的信息。这里有没有我没有正确设置的地方？
回答 1
Stack Overflow用户
发布于 2015-08-27 01:26:31
这是未经测试的。我正在尝试我认为你想要做的事情。您正在将A2过滤为DQ11，因此这是我设置find范围的位置。你粘贴到B2到S2，这只有11列宽，所以这就是我要获取的数据范围。由于您正在粘贴值(不需要格式化)，所以我将直接将目标范围设置为源范围，而不是复制/粘贴。
同样，未经过测试，但我可以尝试帮助解决错误。我预计范围错误XD简而言之，使备份之前，你尝试我的代码。
此外，不确定您是否希望在每个工作表中找到数据。如果是这样，您不能将目标范围设置为常量(B2:S2)，因为较新的数据只会覆盖现有的数据(除非这是您想要的)。您可以考虑添加错误检查。
最后，离题了，但是你已经非常棒地接受了评论和建议，然后做了研究，弄清楚了所有的问题，并提出了新的问题^_^
Sub Pull_data_Click()
Dim A As Variant 'defines name from first subroutine
Dim B As Workbook 'defines destination file
Dim X As Workbook 'defines existing report file as source
Dim Destination As Range 'defines destination range of data pulled from report
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Variant
Dim copyRng As Variant
Dim fRow As Long
Application.ScreenUpdating = False
Set B = Workbooks("filenameB.xlsm") 'constant variable, does not change
Set X = Workbooks.Open("filenameX.xlsm") 'dependent variable, new name for each new report
'once you set a wordbook, you can use it ^_^
A = B.Worksheets("Summary").Range("A1").Value 'constant variable, does not change
Set Destination = B.Worksheets("Input").Range("B2:S2") 'Range changes for each iteration, rows increase by 1
'check if name is entered
If A = "" Then
MsgBox ("Your name is not visible; please start from the Reference tab.")
B.Worksheets("Reference").Activate
Exit Sub
End If
For Each ws In X.Worksheets
with ws.range("A:A")
On Error Resume Next '<---add
Set rng = .Find(What:=A, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
fRow = rng.Row
Set copyRng = ws.Range(Cells(fRow, 1), Cells(fRow, 18)) 'i think you want 18 because you're pasting to a range that is 18 cols wide
Destination = copyRng
end with '<-- move it here
Next ws
Application.ScreenUpdating = True
end sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/32231967
复制相关文章
相似问题
腾讯云开发者
