Extract multiple cells from multiple sheets in a workbook to a master sheet in the said workbook

[ssincerely]

Good Day,
Here is a challenge for the masters of excel (EXCELITES). I have a workbook with multiple sheets, all are formatted the same way and require the said information (SEE BELOW).

	A	B	C	D	E	F	G	I
2		NAME	JOHN BROWN				OFFENCE	LARCENY
3		DOB	27-3-72
4		OCCUPATION	CARPENTER
5		ADDRESS	123 LOVE LANE
6		TELEPHONE	923-1723
		DATE REPORTED			LAST DATE	NEXT DATE
20		31-3-18			24-3-18	17-5-18

<tbody>
</tbody>

The other cells are occupied or merge for other info etc.....


What I now want is a Mastersheet to generate with the information in RED ABOVE in rows (SEE BELOW)

	A	B	C	D	E	F	G	H	I
1	NAME	DOB	OCCUPATION	ADDRESS	TELEPHONE	OFFENCE	DATE REPORTED	LAST DATE	NEXT DATE
2	JOHN BROWN	27-3-72	CARPENTER	123 LOVE LANE	923-1723	LARCENY	31-3-18	24-3-18	17-5-18
3
4

<tbody>
</tbody>

Thanks in advance for any assistance that can even lead me in the right direction....Respect and Jah Love

 

[ssincerely]

Note Data are in Cells C2 to C6, B20, E20, F20 and I2 on the first diagram.

Good Day,
Here is a challenge for the masters of excel (EXCELITES). I have a workbook with multiple sheets, all are formatted the same way and require the said information (SEE BELOW).

	A	B	C	D	E	F	G	I
2		NAME	JOHN BROWN				OFFENCE	LARCENY
3		DOB	27-3-72
4		OCCUPATION	CARPENTER
5		ADDRESS	123 LOVE LANE
6		TELEPHONE	923-1723
		DATE REPORTED			LAST DATE	NEXT DATE
20		31-3-18			24-3-18	17-5-18

<tbody>
</tbody>

The other cells are occupied or merge for other info etc.....


What I now want is a Mastersheet to generate with the information in RED ABOVE in rows (SEE BELOW)

	A	B	C	D	E	F	G	H	I
1	NAME	DOB	OCCUPATION	ADDRESS	TELEPHONE	OFFENCE	DATE REPORTED	LAST DATE	NEXT DATE
2	JOHN BROWN	27-3-72	CARPENTER	123 LOVE LANE	923-1723	LARCENY	31-3-18	24-3-18	17-5-18
3
4

<tbody>
</tbody>

Thanks in advance for any assistance that can even lead me in the right direction....Respect and Jah Love

 

[vcoolio]

Hello SSincerely,

Try the following code in a standard module and assigned to a button:-

Option Explicit
Sub NotSure()

        Dim ws As Worksheet, sh As Worksheet
        Dim x As Long
        Dim cAr As Variant, pAr As Variant

        Set sh = Sheets("Master")
     
Application.ScreenUpdating = False
Application.DisplayAlerts = False

cAr = Array("C2", "C3", "C4", "C5", "C6", "B20", "E20", "F20", "I2")
pAr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I")

For Each ws In Worksheets
If ws.Name <> "Master" Then
For x = LBound(cAr) To UBound(cAr)
        ws.Range(cAr(x)).Copy
        sh.Range(pAr(x) & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
        sh.Columns.AutoFit
        Next x
End If
Next ws

Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

I hope that this helps.

Cheerio,
vcoolio.

 

[ssincerely]

Thanks for your response, something happened yes but it seems the special pasting didn't start in column A as also I wanted to eliminate about 3 sheets namely "Links", "Home Page", "personnel"

Hello SSincerely,

Try the following code in a standard module and assigned to a button:-

Option Explicit
Sub NotSure()

        Dim ws As Worksheet, sh As Worksheet
        Dim x As Long
        Dim cAr As Variant, pAr As Variant

        Set sh = Sheets("Master")
     
Application.ScreenUpdating = False
Application.DisplayAlerts = False

cAr = Array("C2", "C3", "C4", "C5", "C6", "B20", "E20", "F20", "I2")
pAr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I")

For Each ws In Worksheets
If ws.Name <> "Master" Then
For x = LBound(cAr) To UBound(cAr)
        ws.Range(cAr(x)).Copy
        sh.Range(pAr(x) & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
        sh.Columns.AutoFit
        Next x
End If
Next ws

Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

I hope that this helps.

Cheerio,
vcoolio.

 

[vcoolio]

Hello Ssincerely,

........as also I wanted to eliminate about 3 sheets namely "Links", "Home Page", "personnel"

This should have been made crystal clear in your opening post. You cannot assume that we explicitly know your thoughts.

Following is the code again with a couple of minor alterations to the arrays and the excluded worksheets:-

Option Explicit
Sub NotSure()

        Dim ws As Worksheet, sh As Worksheet
        Dim x As Long
        Dim cAr As Variant, pAr As Variant

        Set sh = Sheets("Master")
     
Application.ScreenUpdating = False
Application.DisplayAlerts = False

cAr = Array("C2", "C3", "C4", "C5", "C6", "I2", "B20", "E20", "F20")
pAr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I")

For Each ws In Worksheets
If ws.Name <> "Master" And ws.Name <> "Links" And ws.Name <> "Home Page" And ws.Name <> "Personnel" Then
For x = LBound(cAr) To UBound(cAr)
        ws.Range(cAr(x)).Copy
        sh.Range(pAr(x) & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
        sh.Columns.AutoFit
        Next x
End If
Next ws

Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Following is the link to a mock-up of what I believe your workbook to look like. You'll see that the code works just fine in doing its task:-

http://ge.tt/4BmM9Ep2

You will see that sheets "Master", "Links", "Home Page" and "Personnel" are excluded from the copy/paste and only data from sheets 2, 3 and 4 is transferred to the Master sheet. Click on the "RUN" button to see it work.

If you still experience any issues then please upload a sample of your workbook (an exact replica but with dummy data) to a free file sharing site such as ge.tt or Drop Box and then post the link to your file back here.

Cheerio,
vcoolio.