Compare a list with sheetnames and on match do copy-transpose operations

[Raghuveer20]

Hi!

I have a problem. I have a Workbook named 'SalesData.xlsx' which contains two sheets 'Demand' and 'Availability'. Column A of these worksheets contains CUSTOMER names and remaining thirteen columns contain month-year data.

The following needs to be done with both sheets i.e. 'Demand' and 'Availability'.
I want to select a CUSTOMER name and check if it is available as a sheet in another workbook 'Summary.xlsm'. When it is available, I want to transpose-copy the month-year data of the CUSTOMER to a defined range (corresponding to month-year) in 'Summary.xlsm' as illustrated below.

Hope! someone has a solution.

Regards


'SalesData.xlsx': Contains Sheets 'Demand' and 'Availability'

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	CUSTOMERS	Apr-14	May-14	Jun-14	Jul-14	Aug-14	Sep-14	Oct-14	Nov-14	Dec-14	Jan-15	Feb-15	Mar-15	Annual
2	AAAA	638	736	755	629	683	834	748	850	614	933	810
3	BBBB	922	944	538	901	869	963	892	936	931	609	557
4	CCCC	758	918	799	676	753	840	637	563	517	660	500
5	DDDD	536	955	775	705	692	973	557	974	533	601	700
6	EEEE	774	592	650	842	512	843	753	848	689	954	917
7	FFFF	724	911	594	602	869	819	693	832	942	665	900
8	GGGG	640	902	548	908	796	892	965	501	503	810	687
Demand

'Summary.xlsm': Contains Sheets 'AAAA', 'BBBB', 'CCCC' and so on

Excel 2007
	A	B	C	D	E
1	Month wise sales during the year 2014-15
2	AAAA
3	Month	Sales
4		Demand	Availa- bility	Surplus(+)/ Deficit(-)
5		(Units)	(Units)	(Units)	(%)
6	Apr-14	638
7	May-14	736
8	Jun-14	755
9	Jul-14	629
10	Aug-14	683
11	Sep-14	834
12	Oct-14	748
13	Nov-14	850
14	Dec-14	614
15	Jan-15	933
16	Feb-15	810
17	Mar-15
18	Annual	933	0	-933	-100.0
AAAA

 

[Raghuveer20]

As illustrated above, I want to copy columns to right of AAAA from Demand sheet in SalesData.xlsx workbook to Demand Column in sheet AAAA of summary.xlsm workbook

 

[Raghuveer20]

Hi! I have made the following code with help from some old posts on this site. It is working fine. But, is the code efficient enough? Any suggestions please.

Regards

Sub Summary()
Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
Dim ws As Worksheet
Dim lr As Long, c As Range, fLoc As Range, rng As Range, tLoc As Range


Set wb1 = Workbooks("SalesData.xlsx")
Set wb2 = Workbooks("Summary.xlsm")
Set sh1 = wb1.Sheets("Demand")
Set sh2 = wb1.Sheets("Availability")


lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
For Each ws In wb2.Worksheets
  Set Found = rng.Find(ws.Name, , xlValues, xlWhole, , , False)
        If Not Found Is Nothing Then
            With ws
                Found.Offset(0, 1).Resize(1, 13).Copy
                ws.Range("B6:B18").Resize(13, 1).PasteSpecial Transpose:=True
            End With
            Set Found = Nothing
        End If
Next ws


lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh2.Range("A2:A" & lr)
For Each ws In wb2.Worksheets
  Set Found = rng.Find(ws.Name, , xlValues, xlWhole, , , False)
        If Not Found Is Nothing Then
            With ws
                Found.Offset(0, 1).Resize(1, 13).Copy
                ws.Range("C6:C18").Resize(13, 1).PasteSpecial Transpose:=True
            End With
            Set Found = Nothing
        End If
Next ws
End Sub

 

[Raghuveer20]

I want to put the following code in a new sub and invoke the sub when needed. How do we do that.
Note: Here ws, sh1, wb2, A2:A, B6:B18 are the variables

lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
For Each ws In wb2.Worksheets
  Set Found = rng.Find(ws.Name, , xlValues, xlWhole, , , False)
        If Not Found Is Nothing Then
            With ws
                Found.Offset(0, 1).Resize(1, 13).Copy
                ws.Range("B6:B18").Resize(13, 1).PasteSpecial Transpose:=True
            End With
            Set Found = Nothing
        End If
Next ws