查找和复制代码 [英] Find and copy code
问题描述
我试图创建一些代码，但是没有任何东西可以实现。 ActiveSheet是没有评论的新创建的。所以我想查找列A中的发票号码并复制列K& L，其中从最后的工作表中找到匹配到活性页的K和L列。我希望我有道理，并感谢您的帮助
选项显式
子FindCopy_all（）
Dim calc As Long
Dim Cel As Range
Dim LastRow As Long
Dim rFound As Range
Dim LookRange As Range
Dim CelValue As Variant
'速度
calc = Application.Calculation
随着应用
。计算= xlCalculationManual
.ScreenUpdating = False
以
'获取最后一行数据ActiveSheet，Col A
LastRow = ActiveSheet.Cells（1048576，1）.End（xlUp）.Row
'设置要查找的范围
Set LookRange = ActiveSheet.Range（A1：A& LastRow）
'每个值（单元）循环
对于每个Cel在LookRange中
'获得价值，找到
CelValue = Cel.Value
'看上一张表
With Sheets（Sheets.Count - 3）
Set rFound = .Cells找到（What：= CelValue，_
After：=。Cells（1，1），LookIn：= xlValues，_
Lookat：= xlWhole，MatchCase：= False）
'重置
出错转到endo
'找不到，转到下一个
如果rFound是Nothing然后
转到NextCel
否则
找到了。最后一页，Col K& L到活性片找到Row，Col K& L
.Cells（rFound.Row，11，12）.Resize（，2）.Copy ActiveSheet.Cells（Cel.Row，11，12）
End If
End With
NextCel：
Next Cel
Set rFound = Nothing
'Reset
endo：
With Application
.Calculation = calc
.ScreenUpdating = True
End With
End Sub
您在前面的表单中包含语句， activesheet 语句存在。使用：
.Cells（rFound.Row，11）.Resize（，2）.Copy activesheet.Cells（cel.Row ，11）
另外，你不需要 On Error Resume Next ，因为返回的范围是 nothing 并且确定你 set rFound = nothing < code $>
$ b
NextCel：
set rFound = nothing
我的代码：
$ $ $ $ $ $ $ $ $ $
Dim Cel As Range
Dim LastRow As Long
Dim rFound As Range
Dim LookRange As Range
Dim CelValue As Variant
'Speed
calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'获取最后一行数据ActiveSheet，关口A
LastRow = ActiveSheet.Cells（1048576，1）.End（xlUp）.Row
'设置要在
中查找的范围Set LookRange = ActiveSheet.Range（A1：一个& LastRow）
每个值（单元格）循环
对于每个Cel在LookRange中
'获取值以查找
CelValue = Cel.Value
'看上一张表
有表格（Sheets.Count - 1）
设置rFound = .Range（A：A）。Find（What：= CelValue，_
After：=。Cells（1，1），LookIn：= xlValues，_
Lookat：= xlWhole，MatchCase：= False）
'找不到，去下
If rFound is Nothing Then
GoTo NextCel
Else
'Found。最后一页，Col K& L到活性片找到Row，Col K&
.Cells（rFound.Row，11）.Resize（，2）.Copy ActiveSheet.Cells（Cel.Row，11）
End If
End With
NextCel：
Set rFound = Nothing
Next Cel
With Application
.Calculation = calc
.ScreenUpdating = True
End With
End Sub
Right people, I’m back again for some more help. I have a workbook where I add new worksheets every month with information which is exactly the same as before in structure. In column A, I have invoice numbers then details from columns B:J. In columns K & L there are comments manually added for all outstanding issues. What I want to do is be able to lookup invoices against the last worksheet and then copy comments in columns K & L into the new worksheet.
I have tried to create a bit of code but nothing is coming off it. The ActiveSheet is the newly created without comments. So i want to lookup invoice numbers in columns A and copy columns K & L where a match is found from last worksheet to columns K&L of the activesheet. I hope I make sense and thank you for helping
Option Explicit
Sub FindCopy_all()
Dim calc As Long
Dim Cel As Range
Dim LastRow As Long
Dim rFound As Range
Dim LookRange As Range
Dim CelValue As Variant
' Speed
calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'Get Last row of data ActiveSheet, Col A
LastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
' Set range to look in
Set LookRange = ActiveSheet.Range("A1:A" & LastRow)
' Loop on each value (cell)
For Each Cel In LookRange
' Get value to find
CelValue = Cel.Value
' Look on previous sheet
With Sheets(Sheets.Count - 3)
Set rFound = .Cells.Find(What:=CelValue, _
After:=.Cells(1, 1), LookIn:=xlValues, _
Lookat:=xlWhole, MatchCase:=False)
' Reset
On Error GoTo endo
' Not found, go next
If rFound Is Nothing Then
GoTo NextCel
Else
' Found. last sheet, Col K & L to Active Sheet found Row, Col K & L
.Cells(rFound.Row, 11, 12).Resize(, 2).Copy ActiveSheet.Cells(Cel.Row, 11, 12)
End If
End With
NextCel:
Next Cel
Set rFound = Nothing
'Reset
endo:
With Application
.Calculation = calc
.ScreenUpdating = True
End With
End Sub
You are in a with statement on the previous sheet and no activesheet statement exist. Use:
.Cells(rFound.Row, 11).Resize(,2).Copy activesheet.Cells(cel.Row, 11)
Also, you shouldn't need On Error Resume Next as the range returned will be nothing and also be sure you set rFound = nothing after you've completed each find.
NextCel:
set rFound = nothing
my code:
Option Explicit
Sub FindCopy_all()
Dim calc As Long
Dim Cel As Range
Dim LastRow As Long
Dim rFound As Range
Dim LookRange As Range
Dim CelValue As Variant
' Speed
calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'Get Last row of data ActiveSheet, Col A
LastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
' Set range to look in
Set LookRange = ActiveSheet.Range("A1:A" & LastRow)
' Loop on each value (cell)
For Each Cel In LookRange
' Get value to find
CelValue = Cel.Value
' Look on previous sheet
With Sheets(Sheets.Count - 1)
Set rFound = .Range("A:A").Find(What:=CelValue, _
After:=.Cells(1, 1), LookIn:=xlValues, _
Lookat:=xlWhole, MatchCase:=False)
' Not found, go next
If rFound Is Nothing Then
GoTo NextCel
Else
' Found. last sheet, Col K & L to Active Sheet found Row, Col K & L
.Cells(rFound.Row, 11).Resize(, 2).Copy ActiveSheet.Cells(Cel.Row, 11)
End If
End With
NextCel:
Set rFound = Nothing
Next Cel
With Application
.Calculation = calc
.ScreenUpdating = True
End With
End Sub
这篇关于查找和复制代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
