Hi,
I have a large dataset. I am trying to filter this dataset by a criteria and copy the relevant data only into a template sheet. I'm trying to do this using variables for the sheet names. I seem to be right on the cusp of getting the macro to carry out the task but can't get it to loop through my variables. I have used a variant of this code many times before, (thanks to RoyUK for that one), but can't get the final piece of this code to work.
Any help greatly appreciated. Code below:
Code
Option Explicit
Sub TestCopyPasteSpecificWorkbook()
Dim rCl As Range, rRng As Range
Dim fName As String, SvPath As String
Dim LR As Long
Dim rngData, TargetRange As Range
Dim wbUnSaved As Workbook
MsgBox "Please select a folder to save the completed files"
Application.FileDialog(msoFileDialogFolderPicker).Show
SvPath = CurDir & "\"
With Sheets("Data")
.Range("D1").EntireColumn.Delete
.Range("A1").CurrentRegion.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet1.Range( _
"D1"), Unique:=True
Set rRng = .Range(.Cells(2, 4), .Cells(.Rows.Count, 4).End(xlUp))
End With
For Each rCl In rRng
fName = rCl.Value
Set wbUnSaved = Workbooks.Open("S:\INFO\Template " & fName & ".xlsx")
Set TargetRange = wbUnSaved.Sheets("Data").Range("A1")
ThisWorkbook.Activate
With Sheets("Data")
.Range("D2").Value = rCl.Value
.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("D1:D2"), CopyToRange:=TargetRange, Unique:=False
End With
wbUnSaved.SaveAs SvPath & fName & " - NM.xlsx", _
FileFormat:=51, CreateBackup:=False
ActiveWorkbook.Close True
Next rCl
End Sub
Display More