![](/img/trans.png)
[英]Excel VBA: Find data, loop through multiple worksheets, copy specific range of cells
[英]Excel VBA Update: Find data, loop through multiple worksheets, copy range
從昨天更新到此線程: Excel VBA:查找數據,遍歷多個工作表,復制特定范圍的單元格
(特別感謝findwindow讓我走了這么遠!)
我在某個部分上一直遇到運行時91錯誤,並最終在If / Then語句中跳到下一頁...但是現在我在它下面的行上看到錯誤1004(請參見下文):
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
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")
Set rng = .Find(What:=A, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If ring Is Nothing Then 'do nothing
Else
fRow = rng.Row
Set copyRng = ws.Range(Cells(fRow, 1), Cells(fRow, 18))
Destination = copyRng
End With
Next ws
Application.ScreenUpdating = True
End Sub
昨天,在此發生錯誤91:
fRow = rng.Row
今天,在該區域的“ If / Then”部分中放置了以下內容后,出現錯誤1004(對象“ _Worksheet”的方法“ Range”失敗):
設置copyRng = ws.Range(Cells(fRow,1),Cells(fRow,18))
語法在起作用,似乎在正確的工作簿中查找,但是我不確定它是否卡住了,因為我要搜索的變量(變量A)沒有出現在第一張紙上。 有任何想法嗎?
不確定這是您要找的東西嗎? 如果失蹤了,那末了嗎? 您可以在一行中進行復制。 見下文 ...
For Each ws In X.Worksheets
With ws.Range("A:A")
Set rng = .Find(What:=A, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If rng Is Nothing Then 'do nothing
Else
fRow = rng.Row
ws.Range("A" + CStr(fRow) + ":" + "R" + CStr(fRow)).Copy Destination:=Destination
End If
End With
Next ws
快速說明-以及可能的解決方案:
我看到您正在使用多個工作表-很好,請記住要對設置范圍保持高度警惕。
對於您的Set copyRng
,您可以正確指定ws.Range
,但是您還需要對Cells()
。 有兩個修復程序,使用此修復程序: Set copyRng = ws.Range(ws.Cells(fRow, 1), ws.Cells(fRow, 18))
或者,使用With
(根據我的個人喜好):
With ws
Set copyRng = .Range(.Cells(fRow,1),.Cells(fRow,18))
End with
在With
情況下,您會注意到無論With __
是什么,都可以使用小數作為占位符。 (我喜歡With
,因為如果您的工作表變量很長,或者您只是使用實際名稱,則必須在thisIsMyWorksheet.Range(thisismyWorksheet.Cells(1,1),thisismyworksheet.cells(...
相當長)。
如果那不能解決問題,請告訴我。 在給Range
一個后,忘記顯式提供Cells()
工作表時,我掛了電子表格。
編輯:根據您的評論,首先,您的If ring Is Nothing
好像If ring Is Nothing
都If rng Is Nothing Then
- If rng Is Nothing Then
應該If rng Is Nothing Then
。 我不喜歡“ If(TRUE)然后[隱式不執行任何操作]”。
對於工作表循環,請嘗試以下操作:
For Each ws In X.Worksheets
With ws.Range("A:A")
Set rng = .Find(What:=A, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not rng Is Nothing Then
fRow = rng.Row
Set copyRng = ws.Range(ws.Cells(fRow, 1), ws.Cells(fRow, 18))
Destination.Value = copyRng.Value
End With
Next ws
Application.ScreenUpdating = True
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.