VBA to find text in a column and copy a range of adjacent cells in the same row to another sheet

[JKK22]

Hello,
I am a beginner at Macros.
I want to find the text "T+1" in column C , and in that same row , copy values of cells in columns I-L to another spreadsheet .
So if it finds "T+1" in cell C20, i want to copy the values of cells I20:L20 into another workbook.
I found a way to do it one by one, but I have to believe there is a way to do it using a range.

Here is what i have that works, but I am wondering if there is a better way. I'd appreciate any suggestions.
Thank You

Sub Get Data
Dim nPath As String
Dim fileNameString As String
Dim fileName As String
nPath = "\\Swib\root\ShrInvOper\Fund Accounting\Reporting\InvestOne\"
fileNameString = Format(Date, "dd-mmm-yyyy") & " 1 SIF Holding Detail by Maturity Date" & ".xls"
fileName = Dir(nPath & fileNameString)

Workbooks.Open nPath & fileName
Sheets("Main").Select
Dim a As Long
For a = 2 To ActiveSheet.UsedRange.Rows.Count
If Cells(a, "C").Value = "T+1" Then
Cells(a, "I").Copy
ThisWorkbook.Activate
ActiveSheet.Select
Range("D7").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If
Next
Workbooks.Open nPath & fileName
Sheets("Main").Select
Dim b As Long
For b = 2 To ActiveSheet.UsedRange.Rows.Count
If Cells(b, "C").Value = "T+1" Then
Cells(b, "J").Copy
ThisWorkbook.Activate
ActiveSheet.Select
Range("E7").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Next
Workbooks.Open nPath & fileName
Sheets("Main").Select
Dim c As Long
For c = 2 To ActiveSheet.UsedRange.Rows.Count
If Cells(c, "C").Value = "T+1" Then
Cells(c, "K").Copy
ThisWorkbook.Activate
ActiveSheet.Select
Range("F7").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Next
Workbooks.Open nPath & fileName
Sheets("Main").Select
Dim d As Long
For d = 2 To ActiveSheet.UsedRange.Rows.Count
If Cells(d, "C").Value = "T+1" Then
Cells(d, "L").Copy
ThisWorkbook.Activate
ActiveSheet.Select
Range("G7").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Next
Range("D7").Select
Application.CutCopyMode = False
Workbooks(fileName).Close

End Sub

 

[JKK22]

How did you get the code to 'work well'. In other words, what method did you use to select the correct sheet (tab)? If it changes every day, then you might as well use ActiveSheet - and I'll rejig the code once you answer:

I used ActiveSheet, and yes, "Main" the 'source' data sheet and ActiveSheet the 'destination' sheet?

We need the total line from the same source document also copied into our destination worksheet, but I am having trouble doing that because there is no text to search for . Should I start another thread for that question?

 

[kevin9999]

Yes, another thread would be better. Just a couple of thoughts though: is the total line always the last line in the Main worksheet? If so, it will be easy to code. Also, is the newly dated tab in the destination workbook always the last tab - or the first? We could add these things to this thread if the answer is simple

 

[JKK22]

Yes, another thread would be better. Just a couple of thoughts though: is the total line always the last line in the Main worksheet? If so, it will be easy to code. Also, is the newly dated tab in the destination workbook always the last tab - or the first? We could add these things to this thread if the answer is simple

1. Yes, the total line is always the last line with data in the" Main" worksheet. The cells to copy would be the same as in this threads original question ( columns I:L)
2. For the destination workbook, the newly dated tab is always the 2nd tab. ( The first tab has instructions) . We may be able to change that and make it the first tab if it would greatly help with the macros.

 

[kevin9999]

The cells to copy would be the same as in this threads original question ( columns I:L)

And the destination?

 

[JKK22]

And the destination?

The destination would be in the next available blank cell in column AC

 

[kevin9999]

Do you mean starting from row 1 down (in column AC) or starting from where you pasted the T-1 cells (row 7)? In other words, do you mean the first available blank cell in column AC?

 

[kevin9999]

Assuming you mean the first available cell in column AC, try the following (which should also find the correct destination sheet).

Option Explicit
Sub Get_Data_2()
    
    Dim nPath As String
    Dim fileNameString As String
    Dim fileName As String
    nPath = "\\Swib\root\ShrInvOper\Fund Accounting\Reporting\InvestOne\"
    fileNameString = Format(Date, "dd-mmm-yyyy") & " 1 SIF Holding Detail by Maturity Date" & ".xls"
    fileName = Dir(nPath & fileNameString)
    Workbooks.Open nPath & fileName
    
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = wb.Worksheets("Main")
    Set ws2 = ThisWorkbook.Worksheets(2)

    Dim LRow As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , 1, 2).Row
    
    With ws1.Range("B8:L" & LRow)
        .AutoFilter 2, "T+1"
        .Offset(1, 7).Resize(.Rows.Count - 1, 4).Copy
        ws2.Range("D7").PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = 0
        .AutoFilter
    End With
    
    ws1.Range("I" & LRow).Resize(, 4).Copy
    LRow = ws2.Cells(Rows.Count, "AC").End(3).Row
    ws2.Range("AC" & LRow).PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = 0
    
End Sub

 

[JKK22]

Assuming you mean the first available cell in column AC, try the following (which should also find the correct destination sheet).

Option Explicit
Sub Get_Data_2()
   
    Dim nPath As String
    Dim fileNameString As String
    Dim fileName As String
    nPath = "\\Swib\root\ShrInvOper\Fund Accounting\Reporting\InvestOne\"
    fileNameString = Format(Date, "dd-mmm-yyyy") & " 1 SIF Holding Detail by Maturity Date" & ".xls"
    fileName = Dir(nPath & fileNameString)
    Workbooks.Open nPath & fileName
   
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = wb.Worksheets("Main")
    Set ws2 = ThisWorkbook.Worksheets(2)

    Dim LRow As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , 1, 2).Row
   
    With ws1.Range("B8:L" & LRow)
        .AutoFilter 2, "T+1"
        .Offset(1, 7).Resize(.Rows.Count - 1, 4).Copy
        ws2.Range("D7").PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = 0
        .AutoFilter
    End With
   
    ws1.Range("I" & LRow).Resize(, 4).Copy
    LRow = ws2.Cells(Rows.Count, "AC").End(3).Row
    ws2.Range("AC" & LRow).PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = 0
   
End Sub

Hello and thank you for this work!
1. One problem I see, is the last code pastes the data into the first cell in column AC, which overwrites data already in those cells. I need it to paste into the first BLANK cell starting in column AC, and pasting from AC:AF
2. I'm wondering what the following code actually does - can you explain? LRow = ws1.Cells.Find("*", , xlFormulas, , 1, 2).Row
thank you!

 

[kevin9999]

1. Easy fix (addition of "+1" to one line of code - see below)
2. It finds the last row in a whole sheet with a value and assigns that row number to a variable (LRow). See Range.Find method (Excel) for a full explanation of each part.

Option Explicit
Sub Get_Data_3()
    
    Dim nPath As String
    Dim fileNameString As String
    Dim fileName As String
    nPath = "\\Swib\root\ShrInvOper\Fund Accounting\Reporting\InvestOne\"
    fileNameString = Format(Date, "dd-mmm-yyyy") & " 1 SIF Holding Detail by Maturity Date" & ".xls"
    fileName = Dir(nPath & fileNameString)
    Workbooks.Open nPath & fileName
    
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = wb.Worksheets("Main")
    Set ws2 = ThisWorkbook.Worksheets(2)

    Dim LRow As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , 1, 2).Row
    
    With ws1.Range("B8:L" & LRow)
        .AutoFilter 2, "T+1"
        .Offset(1, 7).Resize(.Rows.Count - 1, 4).Copy
        ws2.Range("D7").PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = 0
        .AutoFilter
    End With
    
    ws1.Range("I" & LRow).Resize(, 4).Copy
    LRow = ws2.Cells(Rows.Count, "AC").End(3).Row + 1
    ws2.Range("AC" & LRow).PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = 0
    
End Sub

 

[JKK22]

That worked great! Thank You!