循环并计数excel包含数据的单元格，然后遍历多次的操作

我是新手vba编码器，拼命地需要一些帮助。

使用下面的代码从另一篇文章，我已经修改它作为一个初学者（可能是这样做的错误方式），我需要

• 在工作表Test中遍历整个列A.
• 计算该范围内包含数据的单元的数量。
• 有了这个数字，我需要将一个文件复制到一个目录，多次将循环中的下一个数字追加到文件名中。

所以例如，如果我发现210个单元格包含数据，我想把这个文件C:\image\test.tif并将其复制210次到C:\temp\imagecopy\test (1).tif ，然后C:\temp\imagecopy\test (2).tif “和C:\temp\imagecopy\test (3).tif等。

但我真的不知道如何实现这一点。 这是我到目前为止。

 Sub CountTextPatterns() Dim rngToCheck As Range Dim cl As Range Set rngToCheck = Range("A1:A10000") //Set up the range that contains the text data Dim nothingHere As Integer Set nothingHere = "" //Loop through range, match cell contents to pattern, and increment count accordingly For Each cl In rngToCheck If nothingHere.Test(cl) Then nothingHere = nothingHere+ 1 End If Next //For anything that isn't a letter or number, simply subtract from the and total row count cntNumber = rngToCheck.Rows.Count - cntnothingHere End Sub //So at this point I believe I should have the total cells that are not blank. Now I need to execute a file copy action that many times using the logic mentioned at the top. 

任何人可以提供援助将不胜感激！

Answer 1

像这样的东西

• 避免使用Application.CountA代替单元计数循环
• 使用FileCopy增量复制文件

您没有指定输出目录是否已经存在，要复制的文件名是用户指定的还是硬编码的等。因此，下面的代码可能受益于testing/error handling这些条件

码

 Sub CopyEm() Dim ws As Worksheet Dim strIn As String Dim strOut As String Dim strFile As String Dim strLPart As String Dim strRPart As String Dim lngCnt As Long Dim lngFiles As Long Set ws = Sheets("Test") lngCnt = Application.CountA(ws.Columns("A")) If lngCnt = 0 Then Exit Sub strIn = "C:\image\" strOut = "C:\imagecopy\" strFile = "test.tif" 'extract string portions of the file name and type outside the copy loop strLPart = Left$(strFile, InStr(strFile, ".") - 1) strRPart = Right$(strFile, Len(strFile) - Len(strLPart)) For lngFiles = 1 To lngCnt FileCopy strIn & strFile, strOut & strLPart & "(" & lngFiles & ")" & strRPart Next End Sub