elmnas
10-22-2016, 02:05 AM
Hello people,
I need a macro that makes following:
Looping through all used cells in Column H.
for each cell in column "H", open every file in a folder "C:\Data".
Loop each cell in the open file column "H" if the value is the same as the value from the first loop.
Copy the value same row from the open file but column "G" into the first file same row but column "G".
Close the file.
I have done a mistake somewhere in the logic I believe cause my result is skipping cells.
Could someone help me?
Sub test()
Dim wb As Workbook
Set Mwb = ActiveWorkbook
Dim folderPath As String
folderPath = "C:\DATA\"
Dim filename As String
filename = Dir(folderPath & "*.xlsx")
For i = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
MioNr = Cells(i, "H").Value
Set wb = Workbooks.Open(folderPath & filename)
wb.Activate
For x = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
CIonr = Cells(x, "H").Value
If CIonr = MioNr Then
Cells(x, "I").Copy
Mwb.Activate
Cells(i, "I").Activate
ActiveSheet.Paste
wb.Close
End If
Next x
Next i
End Sub
The problem is the macro is skipping the last iteration.
Thank you in advance
best regards
Daniel
I need a macro that makes following:
Looping through all used cells in Column H.
for each cell in column "H", open every file in a folder "C:\Data".
Loop each cell in the open file column "H" if the value is the same as the value from the first loop.
Copy the value same row from the open file but column "G" into the first file same row but column "G".
Close the file.
I have done a mistake somewhere in the logic I believe cause my result is skipping cells.
Could someone help me?
Sub test()
Dim wb As Workbook
Set Mwb = ActiveWorkbook
Dim folderPath As String
folderPath = "C:\DATA\"
Dim filename As String
filename = Dir(folderPath & "*.xlsx")
For i = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
MioNr = Cells(i, "H").Value
Set wb = Workbooks.Open(folderPath & filename)
wb.Activate
For x = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
CIonr = Cells(x, "H").Value
If CIonr = MioNr Then
Cells(x, "I").Copy
Mwb.Activate
Cells(i, "I").Activate
ActiveSheet.Paste
wb.Close
End If
Next x
Next i
End Sub
The problem is the macro is skipping the last iteration.
Thank you in advance
best regards
Daniel