Sorting data from same column from various worksheet into another in table forma

Question

Sorting data from same column from various worksheet into another in table format

I have various sheets (called "Slice#"); where # is a varying value called Tier (ranges from 1 to a defined last value).

Each Slice sheet is produced in turn one by one from a prompt window where a # is entered and this represents which rows of data are to be analysed. This analysis of data is done within each of these Slice sheets as they are made. Say that column Y is the data I need to be copied into a new worksheet (say "Table"). However, I want the data from these columns Ys to be pasted in Table sheet column by column. I.e. Slice1 data in column A, Slice2 in column B, Slice3 in column C and so on.

How would I do this? Would I need to use a "LastColumn" function after Slice 1? As I could use an IF function to make sure Slice1's column Y is placed within column A of the Table sheet.

Thanks for help !!

Explanation / Answer

Hi..

Take a look at this and see if it doesn't get the job done. I've set the 3 potential 'changeable' values up as Const values for easy maintenance and adaptability in the future.

I use a "last column" type test from the outset. When using the .xlToLeft() function, if all columns are empty OR if only column A is used, it will return 1, so when it returns 1, we need to test if column A really has something in it or not.

Sub CopyDataColumn()
Const sliceWord = "Slice" 'assumes only Slice sheets start with "Slice"
Const tableWSName = "Table" ' change as needed
Const colToCopy = "Y" ' makes it adaptable
'working variables
Dim tableWS As Worksheet
Dim anyWS As Worksheet
Dim nextCol As Integer
Dim copyRange As Range
  
Set tableWS = ThisWorkbook.Worksheets(tableWSName)
'we start by clearing all old information from
'the table worksheet
tableWS.Cells.ClearContents ' use .Clear to clear values & formats
'look for any sheet in the workbook whose tab name
'starts with "Slice" (or SLICE, etc - case is irrelevant).
For Each anyWS In ThisWorkbook.Worksheets
    'use of UCASE and TRIM helps assure proper matching
    If UCase(Left(Trim(anyWS.Name), Len(sliceWord))) = UCase(sliceWord) Then
      'copy from Y1: down to last used row in Y on the Slice sheet
      Set copyRange = anyWS.Range(colToCopy & "1:" & _
       anyWS.Range(colToCopy & Rows.Count).End(xlUp).Address)
      'find next empty column on Table worksheet
      'if return from .ToLeft() is 1 have to check to see
      'if A1 has anything in it or not.
      nextCol = tableWS.Cells(1, Columns.Count).End(xlToLeft).Column
      If nextCol = 1 Then
        If Not IsEmpty(tableWS.Range("A1")) Then
          'A has data, need to point to column B
          nextCol = 2
        End If
      Else
        nextCol = nextCol + 1
      End If
      copyRange.Copy
      tableWS.Cells(1, nextCol).PasteSpecial xlPasteValues
      'and if you want their formatting alsso
      tableWS.Cells(1, nextCol).PasteSpecial xlPasteFormats
    End If ' end test for "Slice" sheet
Next ' end anyWS loop
'all done, cleanup and
'release assigned resources back to the system
Application.CutCopyMode = Falsee
Set copyRange = Nothing
Set tableWS = Nothing
MsgBox "Data copy completed.", vbOKOnly + vbInformation, "Task Finished"
End Sub

Related Questions

Navigate

• Browse (All)
• Browse S
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.