Compiling Macro Help

[02coamat]

Hi,

I have a workbook with 7 tabs, 1 called "Main" and 1 called "Reference". Others have other names (Let's call them Sheet1, Sheet2 etc.).

I am trying to copy the data held in Sheet1, Sheet2 etc. into the "Main" tab, one under each other, so as to create a masterlist of data held in the other tabs. I want it to copy all data below row 7 from the source sheets into the Main sheet (which starts at row 7 too). Each number of rows in the source lists varies and I want it to paste over/delete what was in the Main sheet before.

This is what I have so far, but I'm not sure it's useful...

Sub SummariseSheets()
Dim ws As Worksheet

Application.ScreenUpdating = False
Sheets("Main").Activate

For Each wsSheet In Worksheets
If wsSheet.Name <> "Main" Or _
wsSheet.Name <> "References" Then
ws.Range("B7:N29").Copy
Worksheets("Main").Range("B6").End(xlDown).Offset(1, 0).PasteSpecial (xlPasteValues)
End If
Next ws
End Sub


Any help would be really appreciated.

 

[hiker95]

I can put in some dummy data if that helps, sorry!

In my reply #2 it says sensitive data changed

That works for me.

 

[02coamat]

https://app.box.com/s/y93ou1m48spgyp9fv5iaym0k9ocdv6t1

Nothing sensitive in there as far as I'm concerned.

 

[hiker95]

02coamat,

Thanks for the latest workbook.

Here is a macro solution for you to consider, that does not use copy paste special, but, uses an array that contains the values of the range in each worksheet. And, the array is then written to the next available blank row in column B in worksheet Main. Then the array is erased, and, then created, and, used for the next worksheet.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub SummariseSheetsV2()
' hiker95, 07/22/2015, ME869887
Dim wm As Worksheet, ws As Worksheet
Dim lrm As Long, lrws As Long, nr As Long, a As Variant
Application.ScreenUpdating = False
Set wm = Sheets("Main")
With wm
  lrm = .Cells(Rows.Count, "B").End(xlUp).Row
  If lrm > 6 Then
    .Range("B7:N" & lrm).ClearContents
  End If
End With
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Main" And ws.Name <> "References" Then
    With ws
      lrws = ws.Cells(Rows.Count, "B").End(xlUp).Row
      nr = wm.Cells(wm.Rows.Count, "B").End(xlUp).Row + 1
      a = ws.Range("B7:N" & lrws).Value
      wm.Range("B" & nr).Resize(UBound(a, 1), UBound(a, 2)) = a
      Erase a
    End With
  End If
Next ws
wm.Activate
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the SummariseSheetsV2 macro.

 

[02coamat]

That's perfect!!!

How does it do it!?

Thank you!

 

[hiker95]

That's perfect!!!
Thank you!

02coamat,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[hiker95]

How does it do it!?

02coamat,

If you want, I can add comment lines to the macro code, to help you understand what is going on?

 

[02coamat]

02coamat,

If you want, I can add comment lines to the macro code, to help you understand what is going on?

That would be so useful! Thank you!

 

[hiker95]

02coamat,

Be back in a little while.

 

[hiker95]

02coamat,

I hope that the following will help you to understand what the macro is doing.

See the comment lines in the below macro that begin with the ' characters.

'   name of the macro
'   |
Sub SummariseSheetsV2()


'          the date the macro was written
'          |             the MrExcel assigned post/thread number
' hiker95, 07/22/2015, ME869887


' It is a good programming practice to define all your variables.
' If there ever is a problem with the macro code, then another
'    programmer should be able to fix the problem.


'   wm is for worksheet Main
'   |                ws is for all the other worksheets
'   |                |  except "Main", and, "References"
Dim wm As Worksheet, ws As Worksheet


'   lrm will find the last used row in worksheet Main
'   |            lrws will find the last used row in the
'   |            |  other worksheets to copy from
'   |            |             nr is the next available blank
'   |            |             |  row in worksheet Main
'   |            |             |           a is a Variant array that
'   |            |             |           |  will hold the values
'   |            |             |           |  of each range in each
'   |            |             |           |  worksheet copied from
Dim lrm As Long, lrws As Long, nr As Long, a As Variant


' turn off screen flickering/updating
Application.ScreenUpdating = False


'  set the wm variable to worksheet "Main"
Set wm = Sheets("Main")


'  we are now working in worksheet wm = "Main"
With wm


' find the last used row in column B
  lrm = .Cells(Rows.Count, "B").End(xlUp).Row
  
  
' if the last used row in column B is
'        greater
'        | than 6
'        | |
  If lrm > 6 Then
  
  
'   clear the contents of range
'   |
    .Range("B7:N" & lrm).ClearContents
  End If
End With


For Each ws In ThisWorkbook.Worksheets


' process the worksheets that are
'                NOT                   NOT
'                |                     |
'                Main                  References
  If ws.Name <> "Main" And ws.Name <> "References" Then
  
  
' we are now working in each of the other worksheets
    With ws
    
    
'     find the last used row of each worksheet
'                        in column B
'                                  |
      lrws = ws.Cells(Rows.Count, "B").End(xlUp).Row
      
      
'     find the next available blank row in worksheet Main
'     |
      nr = wm.Cells(wm.Rows.Count, "B").End(xlUp).Row + 1
      
      
' the a variant array will hold the values of the worksheets
'     |      Range
'     |      |
      a = ws.Range("B7:N" & lrws).Value
      
        
' write the a array to worksheet "Main"
' beginning in "B" the next row
'               |
      wm.Range("B" & nr).Resize(UBound(a, 1), UBound(a, 2)) = a
      
      
'   then
'     erase the a array
'     |
      Erase a
    End With
  End If


' loop to the next worksheet to process
Next ws


' activate worksheet "Main"
wm.Activate


' turn on screen flickering/updating
Application.ScreenUpdating = True


' this is the end of the macro
End Sub