VBA Help - Looping thru a list of values and copy/Paste into another workbook and create a .txt file with the new criteria

Johnny Thunder

Well-known Member
Apr 9, 2010
Office Version
  1. 2016
  1. MacOS
Hello All,

I am working on a project and needed some help with code.

What I am trying to achieve;

Step 1
"Sheet 1" - Contains my list of unique values in Column A - Range A2:A50
- there are 3 blank rows before the next new unique value is found, for example: 1st value is in cell A2, next unique value is in cell A6, cells A3:A5 are blank.

Step 2
"Sheet 2" Is a report that needs the unique value from "Sheet 1" to be pasted in, which then updates all the values to this report. Once the values are updated I need to create a copy of this worksheet to a new workbook to save as a .txt file, and then repeat the process with the next unique value.
- Unique values are pasted to Sheets("Sheet 2").Range("B8")

Step 3
Save File

Create a dialog box to have the user specify where to save the file and title the file "Monthly Report" & Range("RptPeriod")
- Range("RptPeriod") is a named range that appends a time frame to the report.

Hopefully this explanation is clear.

Any help is appreciated.

Using Excel 2007

Some videos you may like

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

Johnny Thunder

Well-known Member
Apr 9, 2010
Office Version
  1. 2016
  1. MacOS
So, I've been messing with this all day and came up with this but it doesn't seem to want to loop properly. Any help to get me further or correct my mess is appreciated!

Sub Test3()
    Dim lastRow As Long

    Set Datastore = Sheets("Fees Analysis")
    Set Finaldest = Sheets("LoadFile")

    lastRow = Datastore.Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Datastore.Range("A9:A240")
    For i = Rng.Cells(1, 1).Row To Rng.Cells(1, 1).End(xlDown).Row

    If Datastore.Range("A" & i).Value <> vbNullString Then
            Finaldest.Range("CCpaste").Value = Datastore.Range("A" & i).Value
    Call SaveSheet
    ActiveWorkbook.Close savechanges:=False
        End If
    Next i
End Sub

Sub SaveSheet()

Dim Sh As Worksheet

Const csPath As String = "C:\Jonathan\Cash Project\"

Sheets("DPL").Copy 'Creates new copy of the sheet to a new workbook

For Each Sh In ActiveWorkbook.Worksheets 'Copies the newly pasted sheet and paste special values to remove formulas
        If Sh.Visible = True Then
            Sh.Range("A1").PasteSpecial Paste:=xlValues
End If

Next Sh

Application.CutCopyMode = False ' Clears Clipboard

 ActiveWorkbook.SaveAs Filename:= _
     csPath & "DPL " & Range("CCpaste").Text & ".txt"

End Sub
Last edited:

Watch MrExcel Video

Forum statistics

Latest member

This Week's Hot Topics