Hi,
I'm trying to extract specific data from a dataset and paste it into a named workbook using variables. I've used this technique previously to good effect but I seem now to be unable to return anything but the first column of data. Is there something I'm doing wrong with the advanced filter? I've changed the criteria it's looking up to, the range it's pasting to, the cell it uses as the base for the range select before the advanced filter and to no avail. It's driving me crackers. Any help greatly appreciated. I can post a small sample workbook too if that is useful, but for now, here's the code:
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("SLAM Data")
.Range("DR1").EntireColumn.Delete
.Range("A4").CurrentRegion.Columns(4).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet1.Range( _
"DR1"), Unique:=True
Set rRng = .Range(.Cells(2, 122), .Cells(.Rows.Count, 122).End(xlUp))
End With
For Each rCl In rRng
fName = rCl.Value
Set wbUnSaved = Workbooks.Open("S:\INFO\COMMON\Finance\VBA Test\Specialty Templates\" & fName & ".xlsx")
Set TargetRange = wbUnSaved.Sheets("Data").Range("A4")
ThisWorkbook.Activate
With Sheets("SLAM Data")
.Range("DP2").Value = rCl.Value
.Range("D4").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("DP1:DP2"), CopyToRange:=TargetRange, Unique:=False
End With
wbUnSaved.SaveAs SvPath & fName & ".xlsx", _
FileFormat:=51, CreateBackup:=False
'Workbooks(fName).Close SaveChanges:=False
Next rCl
End Sub
Display More