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
Joined
Apr 9, 2010
Messages
693
Office Version
  1. 2016
Platform
  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
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
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!

Code:
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
        
        Datastore.Activate
    
    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.Activate
            Sh.Cells.Copy
            Sh.Range("A1").PasteSpecial Paste:=xlValues
            Sh.Range("A1").Select
End If


Next Sh


Application.CutCopyMode = False ' Clears Clipboard




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




End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,901
Messages
6,122,157
Members
449,068
Latest member
shiz11713

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top