CC10
asked on
Excel macro find range under a specific text and then copy
Hello,
I have the following macro written by one of your colleagues. It finds the latest workbook (by date) in a datafile and copies a specific range from a specific worksheet to a range in a separate workbook.
It all works fine. Now I would like an addition.
Rather than having a set range (in the case below, Range("A1:R80")), the macro should search column B until it finds the following text, “OTC FX Options Position Breakdown”, and then it should select the range immediately below, Bx:Jx+10 and copy as before.
So, if the text appears at cell B20, the range would be B21:J31
The range in the second worksheet will remain constant.
Thanks,
CC
Public Sub UpdateMARisk()
Dim strPath As String: strPath = Environ("userprofile") & "\Dropbox\Centa\Centa FXDP\FXDP daily reports\Fixings\"
Dim DestinationFile As String:
DestinationFile = "ThisWorkbook"
Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFileName As String, lngFileNumb As Long, IsFileFound As Boolean
Dim FileLen As Integer, Sourcewb As Workbook, DestWb As Workbook
IsFileFound = False
Application.ScreenUpdating = False
Set objFS = CreateObject("Scripting.Fi leSystemOb ject")
Set objFolder = objFS.GetFolder(strPath)
Set objFiles = objFolder.Files
For Each objF1 In objFiles
If Right(objF1.Name, 3) = "xls" Then
If IsNumeric(Left(objF1.Name, 8)) Then
If lngFileNumb < CLng(Left(objF1.Name, 8)) Then
lngFileNumb = CLng(Left(objF1.Name, 8))
strFileName = objF1.Name
IsFileFound = True
End If
End If
End If
Next
Set objF1 = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFS = Nothing
If IsFileFound Then
Set Sourcewb = Workbooks.Open(strPath & strFileName, , True)
' Sourcewb.Sheets("MA Risk").Range("A1:R80").Cop y Workbooks(DestinationFile) .Sheets("M A Risk").Range("A1:R80")
Sourcewb.Sheets("MA Risk").Range("A1:R80").Cop y Workbooks("TraderPositionS heet.xlsm" ).Sheets(" MA Risk").Range("A1:R80")
Sourcewb.Close
Set Sourcewb = Nothing
'Workbooks(DestinationFile ).Save
Workbooks("TraderPositionS heet.xlsm" ).Save
End If
Application.ScreenUpdating = True
End Sub
I have the following macro written by one of your colleagues. It finds the latest workbook (by date) in a datafile and copies a specific range from a specific worksheet to a range in a separate workbook.
It all works fine. Now I would like an addition.
Rather than having a set range (in the case below, Range("A1:R80")), the macro should search column B until it finds the following text, “OTC FX Options Position Breakdown”, and then it should select the range immediately below, Bx:Jx+10 and copy as before.
So, if the text appears at cell B20, the range would be B21:J31
The range in the second worksheet will remain constant.
Thanks,
CC
Public Sub UpdateMARisk()
Dim strPath As String: strPath = Environ("userprofile") & "\Dropbox\Centa\Centa FXDP\FXDP daily reports\Fixings\"
Dim DestinationFile As String:
DestinationFile = "ThisWorkbook"
Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFileName As String, lngFileNumb As Long, IsFileFound As Boolean
Dim FileLen As Integer, Sourcewb As Workbook, DestWb As Workbook
IsFileFound = False
Application.ScreenUpdating
Set objFS = CreateObject("Scripting.Fi
Set objFolder = objFS.GetFolder(strPath)
Set objFiles = objFolder.Files
For Each objF1 In objFiles
If Right(objF1.Name, 3) = "xls" Then
If IsNumeric(Left(objF1.Name,
If lngFileNumb < CLng(Left(objF1.Name, 8)) Then
lngFileNumb = CLng(Left(objF1.Name, 8))
strFileName = objF1.Name
IsFileFound = True
End If
End If
End If
Next
Set objF1 = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFS = Nothing
If IsFileFound Then
Set Sourcewb = Workbooks.Open(strPath & strFileName, , True)
' Sourcewb.Sheets("MA Risk").Range("A1:R80").Cop
Sourcewb.Sheets("MA Risk").Range("A1:R80").Cop
Sourcewb.Close
Set Sourcewb = Nothing
'Workbooks(DestinationFile
Workbooks("TraderPositionS
End If
Application.ScreenUpdating
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
You would also need to change the destination range in the above code like this.....
Workbooks("TraderPositionSheet.xlsm").Sheets("MA Risk").Range("B" & r)
pls try
Open in new window
EDIT Choice of destinationRegards