tonywatsonhelp
Well-known Member
- Joined
- Feb 24, 2014
- Messages
- 3,147
- Office Version
-
- 365
- 2019
- 2016
- Platform
-
- Windows
Hi Everyone,
I hope this isn't going to sound to complicated as I really need your help on this one?
I have this macro that opens every file in a folder and copies cell values into my spreadsheet, this works perfectly,
However as well as what I've set it up to do, I also need it to find the cell in column A with the value closest to "20" and put this into my excel spreadsheet column C and the closest to ""25" and put this in Column D
I'm really stuck and need this done for a report, please help me if you can?
Basically I'm just looking for the bit of code I'd add to this macro that will make it also find the cell closest to the number 20 and the cell closest to the number 25
Thanks
Tony
I hope this isn't going to sound to complicated as I really need your help on this one?
I have this macro that opens every file in a folder and copies cell values into my spreadsheet, this works perfectly,
However as well as what I've set it up to do, I also need it to find the cell in column A with the value closest to "20" and put this into my excel spreadsheet column C and the closest to ""25" and put this in Column D
I'm really stuck and need this done for a report, please help me if you can?
Basically I'm just looking for the bit of code I'd add to this macro that will make it also find the cell closest to the number 20 and the cell closest to the number 25
Code:
Option Explicit
Const FOLDER_PATH = "C:\Users\iplayer\Documents\Odesk New1\41 Odeskrune Hansen mcro\Patient 47\" 'REMEMBER END BACKSLASH
Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row
rowTarget = Range("A65536").End(xlUp).Offset(1, 0).Row
'check the folder exists
'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False
'set up the target worksheet
Set wsTarget = Sheets("Sheet2")
'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""
'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY
'import the data
With wsTarget
.Range("A" & rowTarget).Value = wsSource.Range("A2").Value
.Range("B" & rowTarget).Value = wsSource.Range("B2").Value 'ok
.Range("Z" & rowTarget).Value = wsSource.Range("A16").Value 'ok
.Range("R" & rowTarget).Value = wsSource.Range("A20").Value 'ok
.Range("S" & rowTarget).Value = wsSource.Range("B20").Value 'ok
.Range("T" & rowTarget).Value = wsSource.Range("A25").Value 'ok
.Range("U" & rowTarget).Value = wsSource.Range("B25").Value
.Range("V" & rowTarget).Value = wsSource.Range("A27").Value
.Range("W" & rowTarget).Value = wsSource.Range("B27").Value
.Range("AA" & rowTarget).Value = wsSource.Range("B16").Value
End With
'close the source workbook, increment the output row and get the next file
wbSource.Close SaveChanges:=False
rowTarget = rowTarget + 1
sFile = Dir()
Loop
errHandler:
On Error Resume Next
Application.ScreenUpdating = True
'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
End Sub
Thanks
Tony