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

DT_5191

New Member
Joined
Mar 10, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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.
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,196
Office Version
  1. 2016
Platform
  1. Windows
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.

VBA Code:
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
 
Solution

DT_5191

New Member
Joined
Mar 10, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,318
Messages
5,641,497
Members
417,212
Latest member
rsturbox

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top