Excel Forum

Code: Select all

Sub Rectangle1_Click()
    Dim r As Range, rall As Range
    Dim rcheck As Range
    Set rcheck = Sheets(1).Range("b1")
    Sheets(1).Range("b3").Resize(1000, 3).ClearContents
    With Sheets(2)
        Set rall = .Range("a3", .Range("a" & .Rows.Count).End(xlUp))
        For Each r In rall
            If InStr(r.Value, rcheck) > 0 Then
                With Sheets(1)
                    .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 3).Value _
                        = r.Resize(1, 3).Value
                End With
            End If
        Next r
    End With
End Sub

Code: Select all

Sub Rectangle1_Click()
    Dim r As Range, rall As Range
    Dim rcheck As Range
    Set rcheck = Sheets(Edit).Range("b1")
    Sheets(Edit).Range("b3").Resize(1000, 3).ClearContents
    With Sheets(raca)
        Set rall = .Range("a3", .Range("a" & .Rows.Count).End(xlUp))
        For Each r In rall
            If InStr(r.Value, rcheck) > 0 Then
                With Sheets(Edit)
                    .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 3).Value _
                        = r.Resize(1, 3).Value
                End With
            End If
        Next r
    End With
End Sub

Code: Select all

Sub Rectangle1_Click()
    Dim r As Range, rall As Range
    Dim rcheck As Range
    Set rcheck = Sheets("edit").Range("b1")
    Sheets("edit").Range("b3").Resize(1000, 4).ClearContents
    With Sheets("raca")
        Set rall = .Range("a3", .Range("a" & .Rows.Count).End(xlUp))
        For Each r In rall
            If InStr(r.Value, rcheck) > 0 Then
                With Sheets("edit")
                    .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 4).Value _
                        = r.Resize(1, 4).Value
                End With
            End If
        Next r
    End With
End Sub

Code: Select all

Sub Rectangle1_Click()
Application.ScreenUpdating = False
Sheets("print").Visible = True
Sheets("print").Select
ActiveSheet.PageSetup.PrintArea = "$b$2:$f$338"
ActiveWindow.SelectedSheets.PrintOut copies:=1, collate:=True
Sheets("print").Visible = True
Application.ScreenUpdating = True
End Sub

Code: Select all

Sub Rectangle1_Click()
    Application.ScreenUpdating = False
    Sheets("print").Visible = True
    Sheets("print").Select
    ActiveSheet.PageSetup.PrintArea = ActiveSheet.Range("b2").CurrentRegion.Address
    ActiveWindow.SelectedSheets.PrintOut copies:=1, collate:=True
    Sheets("print").Visible = True
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub Rectangle1_Click()
    Application.ScreenUpdating = False
    Sheets("print").Visible = True
    Sheets("print").Select
    ActiveSheet.PageSetup.PrintArea = ActiveSheet.Range("b2").CurrentRegion.Address
    ActiveWindow.SelectedSheets.PrintOut copies:=1, collate:=True
    Sheets("print").Visible = True
    Application.ScreenUpdating = True
End Sub