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

[Rowland Hamilton]

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?:

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

 

[Rowland Hamilton]

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:

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]

In answer to first post, this?:

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]

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:

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