• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Consolidate data from different worksheets into a summary worksheet

xlsvba87

New Member
Hi all experts,

I need a help in consolidating line item data from multiple sheets into a Summary Worksheet within a single workbook.

The data needs to be copied from name specific sheets. e.g. Monday, Tuesday and so on. Because other than summary and data sheets, it also has someother sheets which not to be touched.

Copy range is unique across all data sheets.But the range to paste data has to be defined and not the same as the source range. That means if Data copy range is A2:Z51(e.g.50Line items) and the paste range in summary worksheet might be E2:AD51 from 1st data sheet and same ways data from the next worksheet needs to be pasted based on finding the last used row in column E and starts paste in next line.

Thanks
 
Hi !

As you must read the tip just above when you write your post
as in Hui's rollin' banner before to log in :​

chandoo-sample-file-jpg.24535
 
Hi Guys

Sorry for the late response. And also I couldn't have upload option in my workplace. Maybe I will try to explain a bit more clear.

So basically the below code works fine, only the issue is with identifying the last row both in data sheet and summary sheet. This is because the data sheet is basically a combination of manual inputs and pre-mentioned formulas(referring the manual inputs) with provision till 200 rows for each sheet.

In that case, while running the below code, it identifies 200 as Last row in data sheet and copies till that and paste in summary sheet starting from 201th row. Because Summary sheet also contains formulas in the very right end and it gives values based on the data copied here from data sheets.

For instance if a user provides data till 10th row in any of the data sheet, the macro copies me all the 200 rows in it and paste it in the summary worksheet. It considers formulas as data.

To handle this, I need to avoid this conflict.Maybe we can identify the usedrange in A column which always has manual input and copies entire row till that range ends. Am I clear and making sense? Pls provide me a suitable solution. Thanks !!

Code :
Code:
Function LastRow(sh As Worksheet)
  On Error Resume Next
  LastRow = sh.Cells.Find(What:="*", _
  After:=sh.Range("A1"), _
  Lookat:=xlPart, _
  LookIn:=xlFormulas, _
  SearchOrder:=xlByRows, _
  SearchDirection:=xlPrevious, _
  MatchCase:=False).Row
  On Error GoTo 0
End Function

Function LastCol(sh As Worksheet)
  On Error Resume Next
  LastCol = sh.Cells.Find(What:="*", _
  After:=sh.Range("A1"), _
  Lookat:=xlPart, _
  LookIn:=xlFormulas, _
  SearchOrder:=xlByColumns, _
  SearchDirection:=xlPrevious, _
  MatchCase:=False).Column
  On Error GoTo 0
End Function

Sub CopyDataWithoutHeaders()
  Dim sh As Worksheet
  Dim DestSh As Worksheet
  Dim Last As Long
  Dim shLast As Long
  Dim CopyRng As Range
  Dim StartRow As Long

  With Application
  .ScreenUpdating = False
  .EnableEvents = False
  End With

 
  ' set summary worksheet.  Set DestSh = ActiveWorkbook.Worksheets("Summary")

  ' Fill in the start row.  StartRow = 3

  ' Loop through all worksheets and copy the data to the
  ' summary worksheet.  For Each sh In ActiveWorkbook.Worksheets
  If sh.Name <> DestSh.Name Then

  ' Find the last row with data on the summary
  ' and source worksheets.  Last = LastRow(DestSh)
  shLast = LastRow(sh)

  ' If source worksheet is not empty and if the last
  ' row >= StartRow, copy the range.  If shLast > 0 And shLast >= StartRow Then
  'Set the range that you want to copy  Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

  ' Test to see whether there are enough rows in the summary
  ' worksheet to copy all the data.  If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
  MsgBox "There are not enough rows in the " & _
  "summary worksheet to place the data."
  GoTo ExitTheSub
  End If

  ' This statement copies values and formats.  CopyRng.Copy
  With DestSh.Cells(Last + 1, "A")
  .PasteSpecial xlPasteValues
  .PasteSpecial xlPasteFormats
  Application.CutCopyMode = False
  End With

  End If

  End If
  Next

ExitTheSub:

  Application.Goto DestSh.Cells(1)

  ' AutoFit the column width in the summary sheet.  DestSh.Columns.AutoFit

  With Application
  .ScreenUpdating = True
  .EnableEvents = True
  End With
End Sub
 
Last edited by a moderator:
Back
Top