Copy paste the value between two worksheets in different workbook only if they have same sheet name

[2020Rivalry]

Scenario: There have two excel files, one for 2pm and one for 3pm meeting. The files are not exact same, but currently we need to copy some of the data from 2pm file to 3pm one everyday.

Requirements: Only copy the value between two worksheet on two different workbook (2pm and 3pm) if they have the same sheet name. For example, copy paste value from sheet “WK1” workbook “2pm” to sheet “WK1” workbook “3pm”.

3pmTrial.xlsx
	A	B	C	D	E	F	G	H	I	J
1
2	Wk	3			WK3
3
4	KPIs		Target	Accomplished
5				Mon	Tue	Wed	Thu	Fri	Sat	Sun
6	KPI1		0
7	KPI2		L
8	KPI3		2 per Day
9			0
10	KPI4		L
WK3

Cell Formulas
Range	Formula
E2	E2	=CONCAT("WK",B2)

I'm trying with code below but getting this error (Compile error: Invalid or unqualified reference)

Public Sub insert_Data()

Application.ScreenUpdating = False

Dim wb1, wb2 As Workbook
Set wb1 = Workbooks.Open("G:\DDS\TrialData\2pmTrial.xlsx")
Set wb2 = Workbooks.Open("G:\DDS\TrialData\3pmTrial.xlsx")

Dim sh1 As Worksheets
Set sh1 = Workbooks("3pmTrial.xlsx").Worksheets("WK*")

For Each sh1 In Worksheets
    With Workbooks("3pmTrial.xlsx")
        Workbooks("2pmTrial.xlsx").Worksheets(.Range("E2").Value).Range("D6:J10").Value = .Worksheets(.Range("E2").Value).Range("D6:J10").Value
    End With
Next

Application.ScreenUpdating = True
 
End Sub

Thank you!

 

[2020Rivalry]

Sure, I will prepare the example files. Thank you!!

 

[2020Rivalry]

Hi Alex,
example for 8.45 file:

Daily DDS (8.45am) Yr2022 v2 ExampleFile.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	qqq- Daily Direction Setting						Week no:	14		WK14
2		KPIs		Target	Accomplished
3					Mon	Tue	Wed	Thu	Fri	Sat	Sun
4		www	111	0	0	0	0	0
5		eee		L	L	L	L	L	L
6		rrr	222	2 per Day	2	2	2	2
7			2222	0	0	0	1	0
8		ttt	333	L	L	L	L	L	L
9
10		qqq Performance
11		yyy	444	3/wk	0	0	0	0
12			555		0	0	0	0
13		uuu	666	5/wk	0	0	1	0
14			777
15			888
16		iiii	999	< 12 / Wk	9	1
17			000
18			1111
19			2222
20			3333
21		ooo	4444	<0.5 / Wk
22			5555	< 0.2 /Wk
23		ppp	6666	< 1 / Wk	0	1	0	0
24		aaa		3 per Wk
25		sss		NA	0	0	0	1
26		ddd		NA	3	0	0	1
27		fff		NA	1
28			7777	99.9%	99.9
29		ggg	8888	NA	2
30			9999	96.0%	96.6
31
32		qqq Compliance
33		hhh		<0.3	0.04	0.12	0.16	0.16	0.16
34		jjj		<0.2	0.07	0.07	0.07	0.07	0.07
35		kkk		<0.5	0	0.06	0.11	0.17	0.17
36		lll
37		zzz
38		xxx
39		ccc
40		vvv		<0.1	0	0	0	0	0
41		bbb		<2	0	0	0.43	0.57	0.57
42		nnn		1
43		mmm		>85%	100%
44		qqqq		Pass/ Fail
45		wwww		1
46		eeee		1 / day	0	0	0	0
47		rrrr		86%	NIL	86%	100%	100%
48		tttt		100%	100%	100%	100%	100%
49		yyyy		86%	NIL	100%	88%	100%
50		uuuu		100%	100%	100%	100%	100%
51		iiii		<0.30%	-0.04	-0.16	-0.04	0.20
52		oooo		<0.30%	-0.02	-0.11	-0.02	0.10
53		aaaa		<0.30%	-0.02	-0.05	-0.03	0.10
54
55		Lab Use
56		ssss		5	3.5
57		dddd			98%
58		ffff
59		gggg		≤ ±0.23	0.47
60		hhhh		≤ ±0.23	-0.04
61		jjjj		95%	100%
62		kkkk		NA	2/2	4/4	maintenance	3/3	3/3
63		llll		NA	5	10		10	10
64		zzzz		0	0	0		0	0
65		xxxx		0	0	0		0	0
66		cccc		5	0	0		0	0
67		vvvv		5	0	0		0	0
68		bbbb		≤ ±0.23	0.14	-0.25		-1.13	1.79
69		nnnn		≤ ±0.23	0.56	-0.74		-0.13	-0.23
70
71		Main Losses
72		Date	Issue				Initial Root Cause					Action				Status
73		x	xx				xxx					xxxx				xxxxx
74		x1	xx1				xxx1					xxxx1				xxxxx1
75
76
77
78
79
80
81
82
83
84
85
86
87		Daily Action Plan
88		Action								Responsible			Timeline			Status
89		y								yy			yyy
90
91
92
93		Follow up
94		Action								Responsible			Timeline			Status
95		z								zz			zzz			zzz
96
97
98
99
100
101
102
103
WK14

Cell Formulas
Range	Formula
J1	J1	=CONCAT("WK",$H$1)

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
G49	Cell	contains a blank value	text	YES
G49	Cell Value	<0.86	text	NO
F47	Cell	contains a blank value	text	YES
F47	Cell Value	<0.86	text	NO
G47	Cell	contains a blank value	text	YES
G47	Cell Value	<0.86	text	NO
G48	Cell	contains a blank value	text	YES
G48	Cell Value	<1	text	NO
F49	Cell	contains a blank value	text	YES
F49	Cell Value	<0.86	text	NO
H50	Cell	contains a blank value	text	YES
H50	Cell Value	<1	text	NO
H49	Cell	contains a blank value	text	YES
H49	Cell Value	<0.86	text	NO
H48	Cell	contains a blank value	text	YES
H48	Cell Value	<1	text	NO
E50	Cell	contains a blank value	text	YES
E50	Cell Value	<1	text	NO
E49	Cell	contains a blank value	text	YES
E49	Cell Value	<0.86	text	NO
E48	Cell	contains a blank value	text	YES
E48	Cell Value	<1	text	NO
E47	Cell	contains a blank value	text	YES
E47	Cell Value	<0.86	text	NO
F51:H53	Cell Value	>0.3	text	NO
G50	Cell	contains a blank value	text	YES
G50	Cell Value	<1	text	NO
F50	Cell	contains a blank value	text	YES
F50	Cell Value	<1	text	NO
F48	Cell	contains a blank value	text	YES
F48	Cell Value	<1	text	NO
H47	Cell	contains a blank value	text	YES
H47	Cell Value	<0.86	text	NO

Example for 9.45 file:

Daily DDS (9.45am) Y2022 ExampleFile.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1
2		Meeting Venue:		Attendees		Mon	Tue	Wed	Thu	Fri	Sat	Sun
3		Time:		1
4		Revision:		2
5				3
6				4
7				5
8				6
9				7
10				8
11				9
12				10
13
14		qqq - Daily Direction Setting Week: 14
15		KPIs		Target	Machine	Accomplished
16						Mon	Tue	Wed	Thu	Fri	Sat	Sun
17		www	111	0	ALL	0	0	0	0
18		eee		L	ALL	L	L	L	L	L
19		rrr	222	2 per Day	ALL	2	2	2	2
20			2222	0	ALL	0	1	0	0
21		ttt	333	L	ALL	L	L	L	L	L
22		yyy	444	3/wk	ALL	0	0	0	0
23			555		ALL	0	0	0	0
24		uuu	666	5/wk	ALL	0	0	1	0
25			777
26			888
27		iiii	999	< 10 / Wk	ALL	9	1	0	0
28			000
29			1111
30			2222
31			3333
32		ooo	4444	<0.5 / Wk	ALL	0	0	0	0
33			5555	< 0.2 /Wk	ALL	0	0	0	0
34		ppp	6666	< 1.3 / Wk	ALL	0	1	0	0
35		aaa		3 per Wk	ALL	1	0	0	0
36		sss		NA	ALL	0	0	0	1	0
37		ddd		NA	ALL	3	0	1	0	0
38		fff		NA	ALL	1
39			7777	99.9%	ALL	99.9
40		ggg	8888	NA	ALL	2
41			9999	96.0%	ALL	96.6
42		-	-	NA	NA	Fri	Mon	Tue	Wed	Thur
43		-	-	95%	NA	2/2	Verification & Training program	2/2	0	0
44			-	NA	NA	5		5	0	0
45			-	NA	NA	0		0	7	6
46			-	5	NA	0		0	0	0
47			-	5	NA	0		0	0	0
48		-	-	95%	NA	2/2	2/2	2/2	Transducer replaced & Leakage Check	3/3
49			-	NA	NA	5	5	5		10
50			-	NA	NA	0	0	0		0
51			-	5	NA	4	0	0		1
52			-	5	NA	0	0	0		0
53		-	-	< 5 / day	ALL	0	3	1	1	0
54			-	< 5 / day	ALL	2	2	1	0	0
55			-	< 2 / day	ALL	0	0	0	0	0
56			-	< 2 / day	ALL	0	0	0	0	0
57			-	< 1 / day	ALL	0	0	0	0	0
58			-	< 2 / day	ALL	0	0	0	0	0
59
60		Main Losses
61		Date	Issue				Initial Root Cause					Action				Status
62		x	xx				xxx					xxxx				xxxxx
63		x1	xx1				xxx1					xxxx1				xxxxx1
64		x2	xx2				xxx2					xxxx2				Closed
65		x3	xx3				xxx3					xxxx3				closed
66		x4	xx4				xxx4					xxxx4
67
68
69
70
71
72
73
74		Daily Action Plan
75		Action								Responsible			Timeline			Status
76
77
78
79
80		Follow up
81		Action								Responsible			Timeline			Status
82
83
84
85
86
87
88
89
90
WK14

Current VBA Code:

Public Sub insert_Data()

Application.ScreenUpdating = False

Dim wb1 As Workbook, wb2 As Workbook                    ' Need to edit every year (the new files location)
Set wb1 = Workbooks.Open("G:\DDS\Daily DDS (8.45am) Yr2022 v2 ExampleFile.xlsx")
Set wb2 = Workbooks.Open("G:\DDS\Daily DDS (9.45am) Y2022 ExampleFile.xlsm")

Dim sh1 As Variant
Dim sh2 As Worksheet

For Each sh1 In wb1.Worksheets

    If UCase(sh1.Name) Like "WK*" Then
        On Error Resume Next
            Set sh2 = wb2.Worksheets(sh1.Name)
        On Error GoTo 0
        
        If Not sh2 Is Nothing Then
            sh2.Range("B17:D21").Value = sh1.Range("B4:D8").Value
            sh2.Range("F17:L21").Value = sh1.Range("E4:K8").Value ' safety incident, safety trigger, pulsar, quality trigger
            sh2.Range("B22:D41").Value = sh1.Range("B11:D30").Value
            sh2.Range("F22:L41").Value = sh1.Range("E11:K30").Value ' quality performance
            sh2.Range("B62:S74").Value = sh1.Range("B73:S85").Value ' main losses, need to adjust the row height manually
            sh2.Range("B78:S80").Value = sh1.Range("B89:S91").Value ' daily action plan
            sh2.Range("B84:S91").Value = sh1.Range("B95:S102").Value ' follow up
        End If
    End If
Next

Application.ScreenUpdating = True
 
End Sub

So problem is existing for main losses, daily action plan, and follow up table. This is because currently my code is just copy pasting the entire table value including the blanks, however this is not correct (should only paste when there have value). I have highlighted those 8.45 data in yellow, the data that added later is highlighted in red. I wish there is a code that can check how many rows in main losses, daily action plan, and follow up table are used, and only copy paste those data into 9.45 file.

Thanks!!!

 

[Alex Blakenburg]

I don't really understand what you are trying to do. Your 9.45 sheet does not really line up with your 8.45 sheet.
If the 8.45 is variable the 9.45 sheet will be variable as well.
Below is some code that addresses the 8.45 variability but you will need to tackle the 9.45 side yourself.
You will have to do something similar on the 9.45 side to find the sections. Insert a number of rows and paste in the data.

This function is pretty ugly but will get the 3 sections you asked for 8.45
The sub under it is your sub with the changes to call the function.

Function findRng(sh1 As Variant, ByVal strFind As String) As Range

    ' Find start and end of the 3 sections
    Dim foundRow As Long, startRow As Long, endRow As Long
    
    Select Case strFind
    
        Case "Main Losses"
            ' find start of section
            strFind = "Main Losses"
            With Application
                foundRow = .IfError(.Match(strFind, sh1.Range("B:B"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng = Nothing
                Exit Function
            End If
            startRow = foundRow + 2
            
            ' find next section
            strFind = "Daily Action Plan"
            With Application
                foundRow = .IfError(.Match(strFind, sh1.Range("B:B"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng = Nothing
                Exit Function
            End If
            
            endRow = sh1.Range("B" & foundRow).End(xlUp).Row
            If endRow < startRow Then
                Set findRng = Nothing
                Exit Function
            End If
            
        Case "Daily Action Plan"
            ' find start of section
            strFind = "Daily Action Plan"
            With Application
                foundRow = .IfError(.Match(strFind, sh1.Range("B:B"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng = Nothing
                Exit Function
            End If
            startRow = foundRow + 2
            
            ' find next section
            strFind = "Follow up"
            With Application
                foundRow = .IfError(.Match(strFind, sh1.Range("B:b"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng = Nothing
                Exit Function
            End If
            
            endRow = sh1.Range("B" & foundRow).End(xlUp).Row
            If endRow < startRow Then
                Set findRng = Nothing
                Exit Function
            End If
               
        Case "Follow up"
            ' find start of section
            strFind = "Follow up"
            With Application
                foundRow = .IfError(.Match(strFind, sh1.Range("B:b"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng = Nothing
                Exit Function
            End If
            startRow = foundRow + 2
            
            ' Last section on sheet - so get last data row
            endRow = sh1.Range("B" & Rows.Count).End(xlUp).Row
            If endRow < startRow Then
                Set findRng = Nothing
                Exit Function
            End If
        
    End Select
    
    Set findRng = sh1.Range(sh1.Cells(startRow, "B"), sh1.Cells(endRow, "B"))
            
End Function

Modified main routine

Public Sub insert_Data()

Application.ScreenUpdating = False

Dim wb1 As Workbook, wb2 As Workbook                    ' Need to edit every year (the new files location)
Set wb1 = Workbooks.Open("G:\DDS\Daily DDS (8.45am) Yr2022 v2 ExampleFile.xlsx")
Set wb2 = Workbooks.Open("G:\DDS\Daily DDS (9.45am) Y2022 ExampleFile.xlsm")

Dim sh1 As Variant
Dim sh2 As Worksheet

Dim rngsh1 As Range

For Each sh1 In wb1.Worksheets

    If UCase(sh1.Name) Like "WK*" Then
        On Error Resume Next
            Set sh2 = wb2.Worksheets(sh1.Name)
        On Error GoTo 0
        
        If Not sh2 Is Nothing Then
            sh2.Range("B17:D21").Value = sh1.Range("B4:D8").Value
            sh2.Range("F17:L21").Value = sh1.Range("E4:K8").Value ' safety incident, safety trigger, pulsar, quality trigger
                      
            sh2.Range("B22:D41").Value = sh1.Range("B11:D30").Value
            sh2.Range("F22:L41").Value = sh1.Range("E11:K30").Value ' quality performance

'            sh2.Range("B62:S74").Value = sh1.Range("B73:S85").Value ' main losses, need to adjust the row height manually
            Set rngsh1 = findRng(sh1:=sh1, strFind:="Main Losses").Resize(, 18)
            sh2.Range("B62").Resize(rngsh1.Rows.Count, rngsh1.Columns.Count).Value = rngsh1.Value
            
'            sh2.Range("B78:S80").Value = sh1.Range("B89:S91").Value ' daily action plan
            Set rngsh1 = findRng(sh1:=sh1, strFind:="Daily Action Plan").Resize(, 18)
            sh2.Range("B78").Resize(rngsh1.Rows.Count, rngsh1.Columns.Count).Value = rngsh1.Value
            
'            sh2.Range("B84:S91").Value = sh1.Range("B95:S102").Value ' follow up
            Set rngsh1 = findRng(sh1:=sh1, strFind:="Follow up").Resize(, 18)
            sh2.Range("B84").Resize(rngsh1.Rows.Count, rngsh1.Columns.Count).Value = rngsh1.Value
            
        End If
    End If
Next

Application.ScreenUpdating = True
 
End Sub

 

[2020Rivalry]

Hi Alex,

Error message appear when I try to run your code run-time error '91': Object variable and With block variable not set. Highlighting Set rngsh1 = findRng(sh1:=sh1, strFind:="Daily Action Plan").Resize(, 18). Can you help me?

Public Sub insert_Data()

Application.ScreenUpdating = False

Dim wb1 As Workbook, wb2 As Workbook                    ' Need to edit every year (the new files location)
Set wb1 = Workbooks.Open("G:\DDS\Daily DDS (8.45am) Yr2022 v2 ExampleFile.xlsx")
Set wb2 = Workbooks.Open("G:\DDS\Daily DDS (9.45am) Y2022 ExampleFile.xlsm")

Dim sh1 As Variant
Dim sh2 As Worksheet

Dim rngsh1 As Range

For Each sh1 In wb1.Worksheets

    If UCase(sh1.Name) Like "WK*" Then
        On Error Resume Next
            Set sh2 = wb2.Worksheets(sh1.Name)
        On Error GoTo 0
        
        If Not sh2 Is Nothing Then
            sh2.Range("B17:D21").Value = sh1.Range("B4:D8").Value
            sh2.Range("F17:L21").Value = sh1.Range("E4:K8").Value ' safety incident, safety trigger, pulsar, quality trigger
                      
            sh2.Range("B22:D41").Value = sh1.Range("B11:D30").Value
            sh2.Range("F22:L41").Value = sh1.Range("E11:K30").Value ' quality performance

'            sh2.Range("B62:S72").Value = sh1.Range("B73:S85").Value ' main losses, need to adjust the row height manually
            Set rngsh1 = findRng(sh1:=sh1, strFind:="Main Losses").Resize(, 18)
            sh2.Range("B62").Resize(rngsh1.Rows.Count, rngsh1.Columns.Count).Value = rngsh1.Value
            
'            sh2.Range("B76:S78").Value = sh1.Range("B89:S91").Value ' daily action plan
            Set rngsh1 = findRng(sh1:=sh1, strFind:="Daily Action Plan").Resize(, 18)
            sh2.Range("B76").Resize(rngsh1.Rows.Count, rngsh1.Columns.Count).Value = rngsh1.Value
            
'            sh2.Range("B82:S89").Value = sh1.Range("B95:S102").Value ' follow up
            Set rngsh1 = findRng(sh1:=sh1, strFind:="Follow up").Resize(, 18)
            sh2.Range("B82").Resize(rngsh1.Rows.Count, rngsh1.Columns.Count).Value = rngsh1.Value
            
        End If
    End If
Next

Application.ScreenUpdating = True
 
End Sub

Can you explain to me why my 9.45 sheet does not really line up with 8.45 sheet....For finding main losses, daily action plan, and follow up, I think the code will have some difference with findRng (8.45 one) as in 9.45 I only need to know the startrow to insert 8.45 data, am I correct?

I truly appreciate your help. Thanks!!

 

[Alex Blakenburg]

The error you are getting would indicate that the phrase "Daily Action Plan" does not exist in your spreadsheet.
If you believe it does go to the 8.45 sheet hit find Ctrl+F copy in the phrase and then select Match Entire Cell Contents.
If it can't find it then there is something different in how it is entered in the spreadsheet. Match is not case sensitive but if you have an extra space in there somewhere say at the begining or the end it won't find it.

 

[2020Rivalry]

No issue, "Daily Action Plan" all come out....

 

[2020Rivalry]

Hi Alex,

can you help me check my code. It does give me the result I want, even with the error pop out...

Option Explicit

Public Sub insert_Data()

Application.ScreenUpdating = False

Dim wb1 As Workbook, wb2 As Workbook                    ' Need to edit every year (the new files location)
Set wb1 = Workbooks.Open("G:\DDS\Daily DDS (8.45am) Yr2022 v2 ExampleFile.xlsx")
Set wb2 = Workbooks.Open("G:\DDS\Daily DDS (9.45am) Y2022 ExampleFile.xlsm")

Dim sh1 As Variant
Dim sh2 As Worksheet

Dim rngsh1 As Range
Dim rngsh2 As Range

Dim foundRow As Long, startRow As Long, endRow As Long

For Each sh1 In wb1.Worksheets

    If UCase(sh1.Name) Like "WK*" Then
        On Error Resume Next
            Set sh2 = wb2.Worksheets(sh1.Name)
        On Error GoTo 0
        
        If Not sh2 Is Nothing Then
            sh2.Range("B17:D21").Value = sh1.Range("B4:D8").Value
            sh2.Range("F17:L21").Value = sh1.Range("E4:K8").Value ' safety incident, safety trigger, pulsar, quality trigger
                      
            sh2.Range("B22:D41").Value = sh1.Range("B11:D30").Value
            sh2.Range("F22:L41").Value = sh1.Range("E11:K30").Value ' quality performance

'            sh2.Range("B62:S72").Value = sh1.Range("B73:S85").Value ' main losses, need to adjust the row height manually
            Set rngsh1 = findRng(sh1:=sh1, strFind:="Main Losses").Resize(, 18)
            Set rngsh2 = findRng1(sh2:=sh2, strFind:="Main Losses").Resize(, 18)
            rngsh1.Copy
            rngsh2.Insert Shift:=xlShiftDown
            
'            sh2.Range("B76:S78").Value = sh1.Range("B89:S91").Value ' daily action plan
            Set rngsh1 = findRng(sh1:=sh1, strFind:="Daily Action Plan").Resize(, 18)
            Set rngsh2 = findRng1(sh2:=sh2, strFind:="Daily Action Plan").Resize(, 18)
            rngsh1.Copy
            rngsh2.Insert Shift:=xlShiftDown
            
'            sh2.Range("B82:S89").Value = sh1.Range("B95:S102").Value ' follow up
            Set rngsh1 = findRng(sh1:=sh1, strFind:="Follow up").Resize(, 18)
            Set rngsh2 = findRng1(sh2:=sh2, strFind:="Follow up").Resize(, 18)
            rngsh1.Copy
            rngsh2.Insert Shift:=xlShiftDown
            
        End If
    End If
Next

Application.ScreenUpdating = True
 
End Sub

Function code to find 8.45 data:

Function findRng(sh1 As Variant, ByVal strFind As String) As Range

    ' Find start and end of the 3 sections
    Dim foundRow As Long, startRow As Long, endRow As Long
    
    Select Case strFind
    
        Case "Main Losses"
            ' find start of section
            strFind = "Main Losses"
            With Application
                foundRow = .IfError(.Match(strFind, sh1.Range("B:B"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng = Nothing
                Exit Function
            End If
            startRow = foundRow + 2
            
            ' find next section
            strFind = "Daily Action Plan"
            With Application
                foundRow = .IfError(.Match(strFind, sh1.Range("B:B"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng = Nothing
                Exit Function
            End If
            
            endRow = sh1.Range("B" & foundRow).End(xlUp).Row
            If endRow < startRow Then
                Set findRng = Nothing
                Exit Function
            End If
            
        Case "Daily Action Plan"
            ' find start of section
            strFind = "Daily Action Plan"
            With Application
                foundRow = .IfError(.Match(strFind, sh1.Range("B:B"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng = Nothing
                Exit Function
            End If
            startRow = foundRow + 2
            
            ' find next section
            strFind = "Follow up"
            With Application
                foundRow = .IfError(.Match(strFind, sh1.Range("B:b"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng = Nothing
                Exit Function
            End If
            
            endRow = sh1.Range("B" & foundRow).End(xlUp).Row
            If endRow < startRow Then
                Set findRng = Nothing
                Exit Function
            End If
               
        Case "Follow up"
            ' find start of section
            strFind = "Follow up"
            With Application
                foundRow = .IfError(.Match(strFind, sh1.Range("B:b"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng = Nothing
                Exit Function
            End If
            startRow = foundRow + 2
            
            ' Last section on sheet - so get last data row
            endRow = sh1.Range("B" & Rows.Count).End(xlUp).Row
            If endRow < startRow Then
                Set findRng = Nothing
                Exit Function
            End If
        
    End Select
    
    Set findRng = sh1.Range(sh1.Cells(startRow, "B"), sh1.Cells(endRow, "B"))
            
End Function

Function code to find startrow in 9.45:

Function findRng1(sh2 As Variant, ByVal strFind As String) As Range

    ' Find start and end of the 3 sections
    Dim foundRow As Long, startRow As Long
    
    Select Case strFind
    
        Case "Main Losses"
            ' find start of section
            strFind = "Main Losses"
            With Application
                foundRow = .IfError(.Match(strFind, sh2.Range("B:B"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng1 = Nothing
                Exit Function
            End If
            startRow = foundRow + 2
            
        Case "Daily Action Plan"
            ' find start of section
            strFind = "Daily Action Plan"
            With Application
                foundRow = .IfError(.Match(strFind, sh2.Range("B:B"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng1 = Nothing
                Exit Function
            End If
            startRow = foundRow + 2
               
        Case "Follow up"
            ' find start of section
            strFind = "Follow up"
            With Application
                foundRow = .IfError(.Match(strFind, sh2.Range("B:B"), 0), 0)
            End With
            If foundRow = 0 Then
                Set findRng1 = Nothing
                Exit Function
            End If
            startRow = foundRow + 2
        
    End Select
    
    Set findRng1 = sh2.Range(sh2.Cells(startRow, "B"), sh2.Cells(startRow, "S"))
            
End Function

 

[Alex Blakenburg]

Does your wb1 have more than one sheet starting with WK in it ?
When you get the error go to the immediate box and type in the below including the "?" which is a shortcut for "Print"
? sh1.name

 

[2020Rivalry]

Yes, both workbook will have 52 sheets, WK01 to WK52.

 

[Alex Blakenburg]

And did you try this and what name did it return.
When you get the error go to the immediate box and type in the below including the "?" which is a shortcut for "Print"
? sh1.name