Proper With's and If's Copy Data to Master Sheet

Rowland Hamilton

Active Member
Joined
Nov 13, 2009
Messages
250
I modified a code for copying sheet information to a Summary sheet. I keep getting an error with my Endifs and End With Statements. Can you help me?:

Code:
Sub CopyFromAllSheetsButMaster()
    Dim ws As Worksheet
    Dim wsMaster As Worksheet
    Dim lngMasterLastRow As Long
    Dim strData As String
    Dim RowCount As Integer
 
    Application.ScreenUpdating = True
 
    'ActiveSheet.Unprotect "kraken" password specific
 
    Set wsMaster = Worksheets("Summary")
 
    lngMasterLastRow = Cells(65536, 1).End(xlUp).Row + 1
 
    ' Breaklinks
    Call UseBreakLink
 
    For Each ws In Worksheets
        If UCase(ws.Name) = "SUMMARY" Then
        Else
            With ws
                ws.Activate
                'ActiveSheet.Unprotect "kraken" password specific
                Rows("1:7").Select
                With Selection
                    .HorizontalAlignment = xlGeneral
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = False
                End With
 
                Range("p1").Select
                ActiveCell.Formula = "=(65536-COUNTBLANK(A:A)-4)"
                RowCount = ActiveCell.Value
                If RowCount = "0" Then
                Else
                    'ActiveWorkbook.Unprotect "kraken" password specific
                    Range(Cells(10, 1), Cells(RowCount + 10, 15)) _
                    .Copy Destination:=wsMaster.Cells(lngMasterLastRow, 1)
                End With
    Next ws
    Application.ScreenUpdating = True
 
End Sub
Sub UseBreakLink()
'Keep Subroutine
    Dim astrLinks As Variant
    On Error GoTo No_Links
    ' Define variable as an Excel link type.
    astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
    ' Break the first link in the active workbook.
    For i = 1 To UBound(astrLinks)
 
    ActiveWorkbook.BreakLink _
        Name:=astrLinks(i), _
        Type:=xlLinkTypeExcelLinks
Next i
No_Links:
End Sub

Thank you, Rowland
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Rowland Hamilton

Active Member
Joined
Nov 13, 2009
Messages
250
Okay, so I figured that out but need to trouble shoot because my results are wrong. Thanks for letting this big baby figure out how to simply close my statements properly:

Code:
Sub CopyFromAllSheetsButMaster()
    Dim ws As Worksheet
    Dim wsMaster As Worksheet
    Dim lngMasterLastRow As Long
    Dim strData As String
    Dim RowCount As Integer
     
    Application.ScreenUpdating = True
    
    'ActiveSheet.Unprotect "kraken" password specific
     
    Set wsMaster = Worksheets("Summary")
     
    lngMasterLastRow = Cells(65536, 1).End(xlUp).Row + 1
    
    ' Breaklinks
    Call UseBreakLink
    
    For Each ws In Worksheets
        If UCase(ws.Name) = "SUMMARY" Then
        Else
            With ws
                ws.Activate
                'ActiveSheet.Unprotect "kraken" password specific
                    
                    'To unmerge and right justify first 7 rows
                    'Rows("1:7").Select
                     'With Selection
                      '.HorizontalAlignment = xlGeneral
                      '.VerticalAlignment = xlBottom
                      '.WrapText = False
                      '.Orientation = 0
                      '.AddIndent = False
                      '.IndentLevel = 0
                      '.ShrinkToFit = False
                      '.ReadingOrder = xlContext
                      '.MergeCells = False
                     'End With
                
                'Determine last copy row of sheet
                Range("p1").Select
                ActiveCell.Formula = "=(65536-COUNTBLANK(A:A)-4)"
                RowCount = ActiveCell.Value
                If RowCount = "0" Then
                Else
                    'ActiveWorkbook.Unprotect "kraken" password specific
                    Range(Cells(10, 1), Cells(RowCount + 10, 15)) _
                    .Copy Destination:=wsMaster.Cells(lngMasterLastRow, 1)
                End If
            End With
    End If
    Next ws
    Application.ScreenUpdating = True
     
End Sub
 

p45cal

Well-known Member
Joined
Nov 10, 2009
Messages
4,763
In answer to first post, this?:
Code:
Sub CopyFromAllSheetsButMaster()
Dim ws As Worksheet
Dim wsMaster As Worksheet
Dim lngMasterLastRow As Long
Dim strData As String
Dim RowCount As Integer

Application.ScreenUpdating = True
'ActiveSheet.Unprotect "kraken" password specific
Set wsMaster = Worksheets("Summary")
lngMasterLastRow = wsMaster.Cells(65536, 1).End(xlUp).Row + 1

' Breaklinks
Call UseBreakLink

For Each ws In Worksheets
  With ws
    If UCase(.Name) <> "SUMMARY" Then
      '.Unprotect "kraken" password specific
      With .Rows("1:7")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
      End With
      With .Range("p1")
        .Formula = "=(65536-COUNTBLANK(A:A)-4)"
        RowCount = .Value
      End With
      If RowCount <> 0 Then
        '.Unprotect "kraken" password specific
        Range(.Cells(10, 1), .Cells(RowCount + 10, 15)).Copy Destination:=wsMaster.Cells(lngMasterLastRow, 1)
      End If
    End If
  End With
Next ws
Application.ScreenUpdating = True
End Sub
 

Rowland Hamilton

Active Member
Joined
Nov 13, 2009
Messages
250
Thanks, p45cal. With that name, I don't have to tell you yous'a Gangsta. I punked out and started doing more selecting eventhough I hear it makes code more erratic and slower. As you could tell, I kept copying over my data until I changed my code. Your's is probably the more effecient version I need to take a few minutes to understand. But I got the proper result with this code:

Code:
Sub CopyFromAllSheetsButMaster()
    Dim ws As Worksheet
    Dim wsMaster As Worksheet
    Dim lngMasterLastRow As Long
    Dim strData As String
    Dim RowCount As Integer
     
    Application.ScreenUpdating = True
    
    'ActiveSheet.Unprotect "kraken" password specific
     
    Set wsMaster = Worksheets("Summary")
     
    lngMasterLastRow = Cells(65536, 1).End(xlUp).Row + 1
    
    ' Breaklinks
    Call UseBreakLink
    
    For Each ws In Worksheets
        If UCase(ws.Name) = "SUMMARY" Then
        Else
            With ws
                ws.Activate
                'ActiveSheet.Unprotect "kraken" password specific
                    
                    'To unmerge and right justify first 7 rows
                    'Rows("1:7").Select
                     'With Selection
                      '.HorizontalAlignment = xlGeneral
                      '.VerticalAlignment = xlBottom
                      '.WrapText = False
                      '.Orientation = 0
                      '.AddIndent = False
                      '.IndentLevel = 0
                      '.ShrinkToFit = False
                      '.ReadingOrder = xlContext
                      '.MergeCells = False
                     'End With
                
                'Determine last copy row of sheet
                Range("p1").Select
                ActiveCell.Formula = "=(65536-COUNTBLANK(A:A)-4)"
                RowCount = ActiveCell.Value
                If RowCount = "0" Then
                Else
                    'ActiveWorkbook.Unprotect "kraken" password specific
                    'Copy
                    Range(Cells(10, 1), Cells(RowCount + 9, 15)).Copy
                    
                    'Paste
                    Sheets("Summary").Select
                    Range("A65536").Select
                    Selection.End(xlUp).Offset(1, 0).Select
                    ActiveSheet.Paste
                    'wsMaster.Cells(lngMasterLastRow, 1) = strData
                    'lngMasterLastRow = lngMasterLastRow
                End If
            End With
    End If
    Next ws
    Application.ScreenUpdating = True
     
End Sub
Sub UseBreakLink()
'Keep Subroutine
    Dim astrLinks As Variant
    On Error GoTo No_Links
    ' Define variable as an Excel link type.
    astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
    ' Break the first link in the active workbook.
    For i = 1 To UBound(astrLinks)
    
    ActiveWorkbook.BreakLink _
        Name:=astrLinks(i), _
        Type:=xlLinkTypeExcelLinks
Next i
No_Links:
End Sub

G. Rap, Truly Yours, Rowland
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,858
Messages
5,766,796
Members
425,379
Latest member
thedoctor00

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top