VBA - Copy data from multiple sheets to create one long running table in one sheet

[nai98765]

I have a spreadsheet where I have pulled from our accounting system the balance sheets for each company and named the sheets with each company's code. For example CO1, CO2, CO3. There are 18 companies so 18 sheets.
On each of the company sheets are the balance sheet data which is in columns A - S. Row 1 is the column headings and row 2 onwards is the data. The number of rows varies by company.

I would like to create a VBA where it takes the data in columns A - S from row 2 onwards for each company and pastes it onto a 'Master' sheet from row 2 down (because row 1 has the headings already populated in the Master sheet). In the Master sheet however I need to identify which company the data relates to therefore would like to for Column A to have the name of the sheet where the data was copied from, then in columns B - T the data from the sheets which was in columns A - S from row 2 down. I note that the number of rows varies on each sheet and I would like it to pull only all the data from row 2 down to the end based on column A. What I mean by this is that column A on each sheet has the account codes but the number of account codes in each company varies therefore I would like it to pick up all account codes until there is no more in column A.

For reference the workbook is set up with sheets as following:
1) Control sheet - there are other steps that occur to ensure we have all the company data in the same format. This is the first sheet and has instructions on it and macro buttons for other purposes
2) Master sheet called 'BS Summary'
3 onwards = all company sheets (18 of them)

 

[mumps]

This macro makes the following assumptions:
-the Master sheet has headers in row 1 (A:T) including in column A (header could be "Sheet Name")
-the Control sheet and Master sheet are the first two sheets in the workbook

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, x As Long, desWS As Worksheet
    Set desWS = Sheets("Master")
    For x = 3 To 20
        With Sheets(x)
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Range("A2:S" & LastRow).Copy desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0)
            desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(LastRow - 1) = .Name
        End With
    Next x
    Application.ScreenUpdating = True
End Sub

 

[nai98765]

I tried the code but it did not quite work. It is copying the information I believe but not allocating the 'sheet name' correctly. Also weirdly I have a subtotal on each company sheet, it copies all the data correctly but from the final sheet it also is pulling the subtotal which is a couple rows after. Not the end of the work as this can be deleted.
Also I've identified a couple extras that would be great to include:
1) is it possible for the data to copy but as 'paste values' (i.e. not copying the formats, etc)
2) As I said I want to just pull the data where there are account numbers in column A for each sheet from A2 down (so selecting all down to the last populated cell) is it however possible to select all + 1 row. This is because the final row in each company's table has information but it does not have an account number.

Sorry I feel like i'm asking for the world but i'm not amazing at VBA and this spreadsheet I'm creating will cut down an employee's task from 4 hours to less than 5 minutes. So I'm very grateful for any help!!

 

[mumps]

Without seeing how your data is organized, it's difficult to suggest a working solution. Try the macro below. If it still doesn't work as you want, perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, x As Long, desWS As Worksheet
    Set desWS = Sheets("Master")
    For x = 3 To 20
        With Sheets(x)
            LastRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Range("A2:S" & LastRow).Copy
            desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(LastRow - 1) = .Name
        End With
    Next x
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub