Snasui Excel Forum

Code: Select all

Sub nonsale()
    Dim lc As Long, Rc As Long
    Dim tb As Workbook
    Set tb = ThisWorkbook
    Workbooks.Open Filename:=Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select Non Sale files.", MultiSelect:=False)
    If TypeName(strPath) = "Boolean" Then Exit Sub
        
    Sheets(1).Select
    Rows("1:1").Select
    Selection.AutoFilter

    lc = Range("B" & Rows.Count).End(xlUp).Row
    Rc = tb.Sheets("Title").Range("D4").Value
    
    Range("B1").Select
    ActiveSheet.Range("A1:AZ" & lc).AutoFilter Field:=2, Criteria1:=Rc
    Application.Goto Reference:="OFFSET(R1C18,1,,COUNTA(C18)-1,3)"
    Selection.Copy
    tb.Activate
    Sheets("Book1").Activate
    With tb.Sheets("book1")
    
        .Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    
    Sheets(1).Select

    Application.CutCopyMode = False

    Application.Goto Reference:="OFFSET(R1C29,1,,COUNTA(C29)-1,)"
    Selection.Copy
    tb.Activate
    Worksheets("Book1").Activate
    With tb.Sheets("book1")
        .Range("D2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    Worksheets("Title").Activate
    Range("a1").Activate
End Sub

Code: Select all

Sub nonsale()
    Dim lc As Long, Rc As Long
    Dim tb As Workbook, pb As Workbook
    
    Set tb = ThisWorkbook
    Workbooks.Open Filename:=Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select Non Sale files.", MultiSelect:=False)

    Set pb = ThisWorkbook
    
    Sheets(1).Select
    Rows("1:1").Select
    Selection.AutoFilter

    lc = Range("B" & Rows.Count).End(xlUp).Row
    Rc = tb.Sheets("Title").Range("D4").Value
    
    
    Range("B1").Select
    ActiveSheet.Range("A1:AZ" & lc).AutoFilter Field:=2, Criteria1:=Rc
    Application.Goto Reference:="OFFSET(R1C18,1,,COUNTA(C18)-1,3)"
    Selection.Copy
    
    tb.Activate
    Sheets("Book1").Activate
    With tb.Sheets("book1")
    
        .Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    
    pb.Activate
        Sheets(1).Select
        Application.Goto Reference:="OFFSET(R1C29,1,,COUNTA(C18)-1,1)"
    Selection.Copy
    
    tb.Activate
    Sheets("Book1").Activate
    With tb.Sheets("book1")
    
        .Range("D3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    
    
    Worksheets("Title").Activate
    Range("a1").Activate
    
End Sub

Code: Select all

Sub nonsale()
    Dim lc As Long, Rc As Long
    Dim tb As Workbook
    Set tb = ThisWorkbook
    Workbooks.Open Filename:=Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select Non Sale files.", MultiSelect:=False)
    If TypeName(strPath) = "Boolean" Then Exit Sub
        
    Sheets(1).Select
    Rows("1:1").Select
    Selection.AutoFilter

    lc = Range("B" & Rows.Count).End(xlUp).Row
    Rc = tb.Sheets("Title").Range("D4").Value
    
    Range("B1").Select
    ActiveSheet.Range("A1:AZ" & lc).AutoFilter Field:=2, Criteria1:=Rc
    Application.Goto Reference:="OFFSET(R1C18,1,,COUNTA(C18)-1,3),OFFSET(R1C28,1,,COUNTA(C28)-1,1)"
    Selection.Copy
    tb.Activate
    Sheets("Book1").Activate
    With tb.Sheets("book1")
    
        .Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End With
    Sheets(1).Select
    Application.CutCopyMode = False
    Worksheets("Title").Activate
    Range("a1").Activate
End Sub