我目前正在努力将某些单元格值从一行复制到一列中,但它必须满足一个条件:在列#34;电子邮件"之后应该至少有一封电子邮件
E.g:
Name | First Name | Last Name |emails | |
john doe| john | doe | 1@me.com |2@me.com |3@me.com
" |"界定我的电子表格的列。
我想通过每封电子邮件将它们复制到下面的一行,这样我就有3行,每行都有不同的电子邮件地址,但是有相同的数据(姓名,名字和姓氏)
我使用下面的代码,但它根本不起作用:
col = 1
For i = 2 To lastrow
emailnumber = Application.WorksheetFunction.CountA(Range(Cells(i, Email + 1), Cells(i, lastcolumn)))
If emailcount > 0 Then
Cells(i + 1, Email) = Cells(i, Email + col)
col = col + 1
End If
Next i
where: Email = 4
您的帮助将受到高度赞赏!
提前谢谢!
祝你好运, Ionut Sanda
答案 0 :(得分:0)
这应该可以解决问题,所有你需要做的就是最后排序:
Sub test()
Dim rng1 As Range, rngMail As Range, lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set rng1 = Range("A2:C" & lastRow)
Set rngMail = Range("D2:D" & lastRow)
Union(rng1, rngMail.Offset(0, 1)).Copy Range("A" & lastRow + 1)
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Union(rng1, rngMail.Offset(0, 2)).Copy Range("A" & lastRow + 1)
End Sub