Question

I’m a novice vba coder and desperately need some assistance.

Using the code below from another post I have modified it as a starter (likely the wrong way to do this), I need to

• loop over the entire Column A in worksheet Test.
• Count the number of cells in that range that contain data.
• With that count number I need to copy a file into a directory that many times appending the next number in the loop to the file name.

So for instance if I found 210 cells containing data I want to take this file C:\image\test.tif and copy it 210 times to C:\temp\imagecopy\test (1).tif, then C:\temp\imagecopy\test (2).tif” and C:\temp\imagecopy\test (3).tif and so on.

But I truly have no idea how to achieve this. Here is what I have so far.

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. 

Any assistance anyone can provide will be greatly appreciated!

Answer 1

Something like this which

• avoids looping for the cell count, using Application.CountA instead
• uses FileCopy to copy the files incrementally

You didn’t specify whether the output directory already existed, whether the file name to be copied was user specified or hard-coded etc. So the code below may benefit from testing/error handling these conditions

code

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