[英]i need to create loop to copy from excel to paste in Notepad
I have data in two columns A(Barcode) & B(count).我在两列 A(条形码)和 B(计数)中有数据。 I need a macro that copies data from Column A and paste it in notepad multiple times as mentioned in column B. Below is my code that works well for only selected row.
我需要一个宏,它从 A 列复制数据并将其多次粘贴到记事本中,如 B 列所述。下面是我的代码,仅适用于选定的行。 Please help to create a loop so the macro works till last row containing data: Sample Data
请帮助创建一个循环,以便宏工作到包含数据的最后一行:示例数据
Sub Receivinggg()
Dim obj As New DataObject
Dim bc As Variant
Dim i As Integer
Dim j As Integer
j = Cells(ActiveCell.Row, 2).Value
For i = 1 To j
bc = Selection.Value
If Len(bc) < 11 Then
bc = "0" & Selection.Value
End If
obj.SetText bc
obj.PutInClipboard
VBA.AppActivate ("1 - Notepad"), 0
SendKeys "+{INSERT}"
Application.Wait Now + TimeValue("00:00:02")
SendKeys "{Enter}"
Next i
VBA.AppActivate ("Receiving - Excel"), 0
SendKeys "{Down}"
End Sub
Issue stands resolved, I succeeded to add a loop within loop to get the required results.问题已解决,我成功地在循环中添加了一个循环以获得所需的结果。 thanks anyways.
不管怎么说,多谢拉。
Sub test()
Dim bc As Variant
Dim cellrow As Integer
Dim cellcol As Integer
Dim lastrow As Integer
Dim x As Integer
Dim i As Integer
Dim obj As New DataObject
Dim j As Integer
cellrow = 2
cellcol = 1
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lastrow
Cells(cellrow, cellcol).Select
j = Cells(ActiveCell.Row, 2).Value
For x = 1 To j
bc = Selection.Value
If Len(bc) < 11 Then
bc = "0" & Selection.Value
End If
obj.SetText bc
obj.PutInClipboard
VBA.AppActivate ("1 - Notepad"), 0
' VBA.AppActivate ("aaaa - WebUtil"), 0
SendKeys "+{INSERT}"
Application.Wait Now + TimeValue("00:00:03")
SendKeys "{Enter}"
Next x
VBA.AppActivate ("Receiving - Excel"), 0
cellrow = cellrow + 1
Next i
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.