VBA Code - loop through many files and copy paste to a dynamic cell

[imalina]

Hi Guys,

I am returning here, as you could help the first time I posted an issue I had here. Hoping you can help me again.

So I have several excel files. I want to loop through them and copy a single cell from each of them (cell F19 from the 1st sheet). The problem that I have is that I want to paste that value into a single file, but the paste destination depends on another cell value from the files from which I am copying (cell D5).

So: the files from which I am copying have a value in F19 that I want to copy on Column B, depending on the ID, which is found on cell D5.

The file in which I am copying looks like this:

	A	B
1	ID	Value
2	2902
3	2928
4	1777
5	2707
6	2746
7	1224
8	2068
9	2937
10	2709
11	2903
12	2579
13	2926

<colgroup><col style="width:48pt" span="3" width="64"> </colgroup><tbody>
</tbody>

I know the column number where I want to paste and I want to find the row number using =match(D5 from the source file, column A from the destination file,0)

My code so far is the below. I know the red part is ********, but I think you get what I want to do there.

Sub Paylist()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim LastRow As Long, lastcolumn As Long
Dim eRow As Long

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
myExtension = "*.xls"

'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)

'Copy cell F19

wb.Worksheets(1).Range("F19").Copy
Application.DisplayAlerts = False

'Paste values

eRow = MATCH(wb.Worksheets(1).Range("D5"),R1C4:R2500C4,0)

ActiveSheet.Paste Destination:=Worksheets("Paylist").Cells(eRow, 10)

'Save and Close Workbook
wb.Close SaveChanges:=True

'Get next file name
myFile = Dir
Loop

'Message Box when tasks are completed
MsgBox "Task Complete!"

ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Hoping you can help me, as I am clueless at this point (new to VBA).
Thank you very much in advance!
Alina

 

[RCBricker]

So to be clear. the ID and the cell you want to copy are both in the same sheet?

if so I would add a line of code to capture the value of D5 something like...

strD5=wb.worksheets(1).range("D5").value

and then I would run a FOR EACH on the range of column B

For Each cell In rngID
    If cell.Value = strD5 Then
        wb.Worksheets("Paylist").Range("B" & cell.Row).PasteSpecial xlPasteAll
    End If
    Exit For
Next cell

something like that

rich

 

[imalina]

Hi Rich,

Thank you for your input. I seem to get an error for this. I did declare this variable.
strD5=wb.worksheets(1).range("D5").value

Also, how would the For each work? I mean, this would be included in the loop and be run every time I open a source file?

Sorry if I ask stupid questions....