Snasui Excel Forum

Code: Select all

Sub Macro1()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    ws2.Range("D1:M5").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ws2.Range( _
        "D1:M1"), CopyToRange:=ws1.Range("F10"), Unique:=False
End Sub

Code: Select all

Sub Macro2()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    ws2.Range("D1:M100").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ws2.Range( _
"D1:M1"), CopyToRange:=ws1.Range("F10:O100"), Unique:=False
End Sub

Code: Select all

Sub Macro0()
    Sheets("Sheet1").Range("F10:O10000").ClearContents
    Sheets("Sheet2").Columns("D:M").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("B3:B10"), CopyToRange:=Range("F10"), Unique:=False
End Sub

Code: Select all

Sub Macro2()
    Dim woShare As Workbook
    Dim formBook As Workbook
    Set formBook = ThisWorkbook
    Set woShare = Workbooks("สมุดงาน3S.xlsx")
        formBook.Sheets("Form").Range("G2:Q10000").ClearContents
        woShare.Sheets("Sheet1").Columns("D:N").AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Range("B3:B10"), CopyToRange:=Range("G3"), Unique:=False
         formBook.Sheets("Form").Columns("N:N").Select
         Selection.Delete Shift:=xlToLeft
End Sub

Code: Select all

=IFERROR(SMALL(IF(ISNUMBER(MATCH("~"&[Ph_BookShare.xlsx]Sheet1!F$2:F$10000,$B$3:$B$50&"",0)),ROW([Ph_BookShare.xlsx]Sheet1!F$2:F$10000)-ROW([Ph_BookShare.xlsx]Sheet1!$E$2)+1),ROWS(P$3:P3)),"")

Code: Select all

=IF($P3="","",INDEX([Ph_BookShare.xlsx]Sheet1!$F$2:$AG$10000,$P3,MATCH(Q$2,[Ph_BookShare.xlsx]Sheet1!$F$1:$AG$1,0)))

Code: Select all

=IFERROR(SMALL(IF([Ph_BookShare.xlsx]Sheet1!E$2:E$10000<>"",IF(ISNUMBER(MATCH([Ph_BookShare.xlsx]Sheet1!E$2:E$10000,$B$4:$B$10,0)),ROW([Ph_BookShare.xlsx]Sheet1!E$2:E$10000)-ROW([Ph_BookShare.xlsx]Sheet1!$D$2)+1)),ROWS(F$4:F4)),"")

Code: Select all

With formBook.Sheets("TemBilling")
         '.Range("A2:J2").Copy
        .Range("AA2:BB2").Resize(.Range("BC1")).Copy
         wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
     End With

Code: Select all

Sub BeenArPay()
    Dim wbShare As Workbook
    Dim wb As Workbook ' declare wb as workbook
    Dim wdShare As Workbook
    Dim wkShare As Workbook
    Dim formBook As Workbook
    Dim wdShareOpen As Boolean
    Dim wkShareOpen As Boolean
    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range
    Dim rt As Range
    Dim rk As Range
    Dim i As Double
    Set formBook = ThisWorkbook
    Set wbShare = Workbooks("Paid_BookShare.xlsx")
    Set wkShare = Workbooks("MyPay_BookShare.xlsx")
    For Each wb In Workbooks ' loop wb not loop wdShare
        If wb.Name = "Ph_BookShare.xlsx" Then
            wdShareOpen = True
        End If
    Next wb
    If Not wdShareOpen Then
        ChDir "\\Server\DATA (E)\My P S  Project.xls\PS.BookShare\AR.ÃкºÅ١˹Õé"
        Workbooks.Open Filename:="\\Server\DATA (E)\My P S  Project.xls\PS.BookShare\AR.ÃкºÅ١˹Õé\Ph_BookShare.xlsx"
    End If
    Set wdShare = Workbooks("Ph_BookShare.xlsx") 'set wdShare after open not before open
    With formBook.Sheets("Form")
        Set rSource = .Range("B3:B50")
    End With
    With wdShare.Sheets("Sheet1")
        Set rTarget = .Range("f2", .Range("f" & Rows.Count).End(xlUp))
    End With
    With formBook.Sheets("Form")
        i = (.Range("L4") + .Range("M11") + .Range("M12"))
        If i <> .Range("J12") Then
            MsgBox "â»Ã´µÃǨ¨Ó¹Ç¹à§Ô¹áÅкѹ·Ö¡ãËÁè"
            Exit Sub
        End If
    End With
    Application.Calculation = xlCalculationManual
    For Each rs In rSource
        For Each rt In rTarget
           If rt = rs Then rt.Offset(0, 28).Resize(, 2) = "Y"
        Next rt
    Next rs
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    With formBook.Sheets("TemBilling")
         '.Range("A2:J2").Copy
        .Range("AA2:BB2").Resize(.Range("BC1")).Copy
         wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
     End With
    With formBook.Sheets("TemBilling")
        .Range("A11:F11").Copy
        wbShare.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    End With
     
    Application.ScreenUpdating = False
    If Sheets("Form").Range("J4") = "à§Ô¹Ê´" Then
        Set rk = wkShare.Sheets("Cash").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        With formBook.Sheets("TemBilling")
            .Range("A20:N20").Copy
            wkShare.Sheets("Cash").Range("A" & Rows.Count).End(xlUp) _
            .Offset(1, 0).PasteSpecial xlPasteValues
        End With
    Else
        Set rk = wkShare.Sheets("Check").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        With formBook.Sheets("TemBilling")
            .Range("A20:N20").Copy
            wkShare.Sheets("Check").Range("A" & Rows.Count).End(xlUp) _
            .Offset(1, 0).PasteSpecial xlPasteValues
        End With
    End If
    formBook.Save
    wdShare.Save
    wkShare.Save
    wdShare.Save
    'formBook.Sheets("Form").Range("H1,L4:N4,N11:N12").ClearContents
    With formBook.Sheets("Form")
        .Range("K4") = .Range("K4") + 1
        .Range("M2") = .Range("M2") + 1
        .Range("N2") = .Range("N2") + 1
    End With
   Application.ScreenUpdating = True
End Sub