Excel 2003 VBA 定位和查找复制到新工作表
我试图让此代码查找 12 月内的任何日期并将其复制到同一工作簿中的工作表中。 LSheetL 是我 12 月的标签。我还创建了其他 11 个月的选项卡，并且必须每个月复制这段代码，是否有更简单/更统一的方法来实现逐月扫描/复制/粘贴到适当的选项卡中？ -- 我的问题是，每当我执行此代码时，它都会给出“Microsoft Visual Basic - 运行时错误'1004' - 应用程序定义或对象定义的错误”。有什么想法吗？我正在考虑删除这段代码并采用另一种方法，但我想看看在我跳过之前我们是否可以解决这个问题。我还被告知，激活不同的工作表并不是从这里到那里获取数据的“最漂亮”的方法，是否有更漂亮的方法来执行此功能？感谢您的任何帮助。
[代码]
While LContinue = True
LastRow = Cells(65535, "q").End(xlUp).Row
If Month(Range("Q" & CStr(LRow)).Value) = 12 Then
Range("E" & CStr(LRow) & ",G" & CStr(LRow) & ",K" & CStr(LRow) & ",O" & CStr(LRow) & ",P" & CStr(LRow) & ",Q" & CStr(LRow) & ",AK" & CStr(LRow)).Select
Selection.Copy
Sheets(LSheetL).Activate
Range("A" & CStr(LCurPRow)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
LCurPRow = LCurPRow + 1
Sheets(LSheetMain).Activate
End If
LRow = LRow + 1
Wend
MsgBox "The copy has completed successfully."
[/代码]
Im trying to get this code to find any date within December and copy it to a worksheet within the same workbook. LSheetL is my December tab. Ive got the other 11 month tabs created as well and will have to duplicate this chunk of code for each month, is there an easier/more consolidated way to achieve a month by month scan/copy/paste into appropriate tab? -- My problem is that whenever I execute this code it gives me a "Microsoft Visual Basic - Run-time error '1004' - Application-defined or object-defined error". Any ideas? Im thinking about scraping this code and going with another approach but I'd like to see if we can get this worked out before I just skip around. I've also been told that activating different sheets is not the 'prettiest' method of getting data from here to there, is there a prettier way to execute this function? Thanks for any help.
[code]
While LContinue = True
LastRow = Cells(65535, "q").End(xlUp).Row
If Month(Range("Q" & CStr(LRow)).Value) = 12 Then
Range("E" & CStr(LRow) & ",G" & CStr(LRow) & ",K" & CStr(LRow) & ",O" & CStr(LRow) & ",P" & CStr(LRow) & ",Q" & CStr(LRow) & ",AK" & CStr(LRow)).Select
Selection.Copy
Sheets(LSheetL).Activate
Range("A" & CStr(LCurPRow)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
LCurPRow = LCurPRow + 1
Sheets(LSheetMain).Activate
End If
LRow = LRow + 1
Wend
MsgBox "The copy has completed successfully."
[/code]
如果你对这篇内容有疑问，欢迎到本站社区发帖提问 参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱，如果其他用户或者作者回复了您的评论，将不能在第一时间通知您！
发布评论
评论（1）
首先把你的完整代码贴出来，这样更容易发现问题。
然后我看不到你何时改变 while 循环的条件，所以基本上循环永远不会结束。
LastRow = Cells(65535, "q").End(xlUp).Row
这条线对我来说似乎是错误的，方法 Cells 将两个数字作为参数，所以“q”可能是您出现此错误的原因。
要解决此问题，请使用 Methode Range，如下所示：Range("Q65535") 或 Cells(65535,17)
First please post your entire code, this will be easier to find the problem.
Then i don't see when you change the condition of your while loop, so basically the loop never end.
LastRow = Cells(65535, "q").End(xlUp).Row
This line seems wrong to me, the method Cells take two number as parameters, so "q" is problably the reason you've got this error.
To fiw this, use the Methode Range like this : Range("Q65535"), or Cells(65535,17)