• 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.

Merge worksheet code

S

SEAN54

New Member
I am using a merge code to consolidate data into single w/sheet. It works fine but when copying the data from the individual worksheets it overwrites on the last row that has a data, meaning I need it to allow a blank row before pasting the data.
Please advise how to fix.
Thanks
<<< Use Code - tags >>>​
Code: 
Sub Consolidate_Data()
'Procedure to Consolidate all sheets in a workbook

On Error GoTo IfError

'1. Variables declaration
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range

'2. Disable Screen Updating - stop screen flickering
'   And Disable Events to avoid inturupted dialogs / popups
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'3. Delete the Consolidate_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True

'4. Add a new WorkSheet and name as 'Consolidate_Data'
With ActiveWorkbook
    Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    DstSht.Name = "Consolidate_Data"
End With

'5. Loop through each WorkSheet in the workbook and copy the data to the 'Consolidate_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
    If Sht.Name <> DstSht.Name Then
       '5.1: Find the last row on the 'Consolidate_Data' sheet
       DstRow = fn_LastRow(DstSht)
      
              
       '5.2: Find Input data range
       LstRow = fn_LastRow(Sht)
       LstCol = fn_LastColumn(Sht)
       EnRange = Sht.Cells(LstRow, LstCol).Address
       Set SrcRng = Sht.Range("A1:" & EnRange)
      
       '5.3: Check whether there are enough rows in the 'Consolidate_Data' Worksheet
        If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
            MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
            GoTo IfError
        End If
              
      '5.4: Copy data to the 'consolidated_data' WorkSheet
        SrcRng.Copy Destination:=DstSht.Range("A" & DstRow)
              
    End If

Next
DstSht.Range("A1").Select

IfError:

'6. Enable Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub
'In this example we are finding the last Row of specified Sheet
Function fn_LastRow(Sht As Worksheet)

    Dim lastRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow

End Function

'In this example we are finding the last column of specified Sheet
Function fn_LastColumn(Sht As Worksheet)

    Dim lastCol As Long
    lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
    lCol = Sht.Cells.SpecialCells(xlLastCell).Column
    Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
        lCol = lCol - 1
    Loop
    fn_LastColumn = lCol

End Function
 
Last edited by a moderator:
Try this

Code: 
'5.4: Copy data to the 'consolidated_data' WorkSheet       
SrcRng.Copy Destination:=DstSht.Range("A" & DstRow+1)
 
I tried that but it messes up some date formulas. see attached.
 

Attachments

  • Merge Sheets.xlsm
    100.7 KB · Views: 1
Can you try this:

Code: 
  '5.1: Find the last row on the 'Consolidate_Data' sheet
  DstRow = DstSht.Range("B" & Rows.Count).End(xlUp).Row + 2
  If DstRow = 3 Then DstRow = 1
   
  '5.2: Find Input data range
  LstRow = fn_LastRow(Sht)
  LstCol = fn_LastColumn(Sht)
  EnRange = Sht.Cells(LstRow, LstCol).Address
  Set SrcRng = Sht.Range("A1:" & EnRange)
   
  '5.3: Check whether there are enough rows in the 'Consolidate_Data' Worksheet
  If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
  MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
  GoTo IfError
  End If
   
  '5.4: Copy data to the 'consolidated_data' WorkSheet
   
  SrcRng.Copy Destination:=DstSht.Range("A" & DstRow)

If this isn't right please explain in detail what is wrong ?
 
Your code was looking up the last row in Column A but there was more data in Column B.

Then just needed to add a blank row
and Check if first time and reset to Row 1 in that case
 
You will also see that I use a single line for determining the last row, rather than step through the file
Code: 
DstRow = DstSht.Range("B" & Rows.Count).End(xlUp).Row

This is so much quicker and simpler and hence isn't put into a function
 
You must log in or register to reply here.
Back
Top