Excel VBA copying rows from one workbook to another after specific text

[DT_5191]

Hello. I am new to VBA and hope someone can help. I have searched many threads and can't find exactly what I need. I have two workbooks and I need:

- to search the second workbook for a specific line of text (ex. Total) in column F - it could be anywhere from rows 25 to 300.
- once it finds the correct row with 'Total', copy rows 9 to 18 from the first workbook then
- paste rows 9-18 in the second workbook three rows below 'Total'.

Thank you in advance for any assistance.

 

[Zot]

I put remark on code to describe the step and the code syntax. In this example I presume the data you wanted to copy in in Sheet1 column A and the destination is also in Sheet1 in another workbook. Instead of repetively writing long workbook names and sheet names on every line, I have use variables to declare those workbook and worksheet in shorter variables to simplify writing.

Sub Test()

Dim Fname As Variant
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wbA As Workbook, wbB As Workbook
Dim rngTotal As Range

Application.ScreenUpdating = False

' Define this Workbook as wbA
Set wbA = ActiveWorkbook
' Define working sheet in wbA. Change sheet name accordingly
Set ws1 = wbA.Sheets("Sheet1")

' Search destination Workbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
' To stop execution if CANCEL is clicked
If Fname = False Then Exit Sub                                  

' Define opened Workbook as wbB while opening it.
Set wbB = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
' Define working sheet in wbB. Change sheet name accordingly
Set ws2 = wbB.Sheets("Sheet1")

' Search for range Total on wbB range F(25:300)
Set rngTotal = ws2.Range("F25", "F300").Find("Total")

' Copy row 9 to 18 from wbA Sheet1 to wbB Sheet1
ws1.Range("A9", "A18").Copy rngTotal

End Sub

 

[DT_5191]

I put remark on code to describe the step and the code syntax. In this example I presume the data you wanted to copy in in Sheet1 column A and the destination is also in Sheet1 in another workbook. Instead of repetively writing long workbook names and sheet names on every line, I have use variables to declare those workbook and worksheet in shorter variables to simplify writing.

Sub Test()

Dim Fname As Variant
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wbA As Workbook, wbB As Workbook
Dim rngTotal As Range

Application.ScreenUpdating = False

' Define this Workbook as wbA
Set wbA = ActiveWorkbook
' Define working sheet in wbA. Change sheet name accordingly
Set ws1 = wbA.Sheets("Sheet1")

' Search destination Workbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
' To stop execution if CANCEL is clicked
If Fname = False Then Exit Sub                                 

' Define opened Workbook as wbB while opening it.
Set wbB = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
' Define working sheet in wbB. Change sheet name accordingly
Set ws2 = wbB.Sheets("Sheet1")

' Search for range Total on wbB range F(25:300)
Set rngTotal = ws2.Range("F25", "F300").Find("Total")

' Copy row 9 to 18 from wbA Sheet1 to wbB Sheet1
ws1.Range("A9", "A18").Copy rngTotal

End Sub

Thank you!! This worked very well.

 

[Zot]

Thank you!! This worked very well.

Thank you for update.