Copy and paste from numerous tabs into a single column

[junkforhr]

I have an excel spreadsheet with tabs called, DSC,FAO, YAS, EMS, RET. I want to reference the sheets that need to be copied. So on the “Lookup” sheet in cell A1 the value will be “EMS”, in cell A2 the values will be “FAO”. I want the code to cater for new sheets to copy without it be hard coded in the VBA.



So the first sheet to be copied will be EMS, which will be in cell A1 on the “lookup” sheet, the code should start looking at the values from G2 and go look at all the any cell that has a value and copy this. This then should be copied onto the “Lookup” sheet and paste into cell B2. The code should then move onto the next sheet which will be refenced in cell A2 on the “Lookup” sheet. It will then copy all cells with values start from cell G2. The code then should append this copied data below the previously copied data. Then it should then repeat the process for sheets that are reference in A3 etc.



Example of EMS tab

Header1	Header2	Header3	Header4	Header5	Header6	Header7	Header8
Text1	Text8	Text15	Text22	Text29	Text36	Text43	Text50
Text2	Text9	Text16	Text23	Text30	Text37	Text44	Text51
Text3	Text10	Text17	Text24	Text31	Text38	Text45	Text52
Text4	Text11	Text18	Text25	Text32	Text39	Text46	Text53
Text5	Text12	Text19	Text26	Text33	Text40	Text47	Text54
Text6	Text13	Text20	Text27	Text34	Text41	Text48	Text55
Text7	Text14	Text21	Text28	Text35	Text42	Text49	Text56

Example of FAO tab

Header1	Header2	Header3	Header4	Header5	Header6	Header7	Header8
Tex57	ABC1	FGD1	HJU1	PPP3	HYT89	JHY321	HAHSAHS5
Tex58	ABC2	FGD2	HJU2	PPP4	HYT90	JHY322	HAHSAHS6
Tex59	ABC3	FGD3	HJU3	PPP5	HYT91	JHY323	HAHSAHS7
Tex60	ABC4	FGD4	HJU4	PPP6	HYT92	JHY324	HAHSAHS8
Tex61	ABC5	FGD5	HJU5	PPP7	HYT93	JHY325	HAHSAHS9
Tex62	ABC6	FGD6	HJU6	PPP8	HYT94	JHY326	HAHSAHS10
Tex63	ABC7	FGD7	HJU7	PPP9	HYT95	JHY327	HAHSAHS11

Desired outcome for the examples provided on the tab called Lookup in starting from B2

Lookup

Tex57

Tex58

Tex59

Tex60

Tex61

Tex62

Tex63

ABC1

ABC2

ABC3

ABC4

ABC5

ABC6

ABC7

FGD1

FGD2

FGD3

FGD4

FGD5

FGD6

FGD7

HJU1

HJU2

HJU3

HJU4

HJU5

HJU6

HJU7

PPP3

PPP4

PPP5

PPP6

PPP7

PPP8

PPP9

HYT89

HYT90

HYT91

HYT92

HYT93

HYT94

HYT95

JHY321

JHY322

JHY323

JHY324

JHY325

JHY326

JHY327

HAHSAHS5

HAHSAHS6

HAHSAHS7

HAHSAHS8

HAHSAHS9

HAHSAHS10

HAHSAHS11

Text1

Text2

Text3

Text4

Text5

Text6

Text7

Text8

Text9

Text10

Text11

Text12

Text13

Text14

Text15

Text16

Text17

Text18

Text19

Text20

Text21

Text22

Text23

Text24

Text25

Text26

Text27

Text28

Text29

Text30

Text31

Text32

Text33

Text34

Text35

Text36

Text37

Text38

Text39

Text40

Text41

Text42

Text43

Text44

Text45

Text46

Text47

Text48

Text49

Text50

Text51

Text52

Text53

Text54

Text55

Text56

 

[excelginge]

Hi,

Below is VBA that will answer you problem.

Note no frills vba. It does not check if worksheet exists or if sheet has no data.

Was not sure if I understand your question. If I've got it wrong let me know where i went wrong and will correct it.

Sub getData()
    Dim lastrowA As Long
    Dim wsLU As Worksheet
    Dim i As Long
    Dim b As Long
    Dim wsDataSheet As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim dr As Long
    Dim dc As Long
    Set wsLU = ThisWorkbook.Worksheets("Lookup")
   
        'delete Lookup Row "B"
   
    wsLU.Columns(2).Delete

    b = 2
    lastrowA = wsLU.Cells(wsLU.Rows.Count, "A").End(xlUp).Row
   
    'loop through each worksheet in column 'A'
   
   
   
   
    For i = 1 To lastrowA
       
        Set wsDataSheet = ThisWorkbook.Worksheets(wsLU.Cells(i, 1).Value)
   
        lastRow = LastRowColumn(wsDataSheet, "R")
        lastCol = LastRowColumn(wsDataSheet, "C")
       
        For dc = 1 To lastCol
            For dr = 2 To lastRow
                wsLU.Cells(b, 2) = wsDataSheet.Cells(dr, dc).Value
                b = b + 1
            Next dr
        Next dc
   
   
   
   
    Next i
   
   

End Sub
Function LastRowColumn(sht As Worksheet, RowColumn As String) As Long
'PURPOSE: Function To Return the Last Row Or Column Number In the Active Spreadsheet
'INPUT: "R" or "C" to determine which direction to search

    Select Case LCase(Left(RowColumn, 1)) 'If they put in 'row' or column instead of 'r' or 'c'.
      Case "c"
        LastRowColumn = sht.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious).Column
      Case "r"
        LastRowColumn = sht.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious).Row
      Case Else
        LastRowColumn = 1
    End Select

End Function

 

[alansidman]

You can use Power Query to append each of the sheets and then unpivot the data.
Here is the Mcode once each table has been loaded.

let
    Source = Table.Combine({Table1, Table2}),
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(Source, {}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Columns",{"Attribute"})
in
    #"Removed Columns"