Excel Forum

Code: Select all

Dim x As Range
Dim answer As VbMsgBoxResult
answer = MsgBox("¤Ø³µéͧ¡Òúѹ·Ö¡¢éÍÁÙÅãªèËÃ×ÍäÁè", vbYesNo, "ºÑ¹·Ö¡¢éÍÁÙÅ")
If answer = vbYes Then
    On Error Resume Next
    Set x = Range("f9:ab18").SpecialCells(xlCellTypeBlanks)
    'If Range("F9").Value = "" Or Range("F10").Value = "" Or Range("F11").Value = "" Or Range("F12") = "" Or Range("F13") = "" Or Range("F14") = "" Or Range("F14") = "" Or Range("F15") = "" Or Range("F16") = "" Or Range("F17") = "" Or Range("F18") = "" Or Range("G9").Value = "" Or Range("G10").Value = "" Or Range("G11").Value = "" Or Range("G12") = "" Or Range("G13") = "" Or Range("G14") = "" Or Range("G14") = "" Or Range("G15") = "" Or Range("G16") = "" Or Range("G17") = "" Or Range("G18") = "" _
    'Or Range("H9") = "" Or Range("H10") = "" Or Range("H11") = "" Or Range("H12") = "" Or Range("H13") = "" Or Range("H14") = "" Or Range("H15") = "" Or Range("H16") = "" Or Range("H17") = "" Or Range("H18") = "" Or Range("I9") = "" Or Range("I10") = "" Or Range("I11") = "" Or Range("I12") = "" Or Range("I13") = "" Or Range("I14") = "" Or Range("I15") = "" Or Range("I16") = "" Or Range("I17") = "" Or Range("I18") = "" _
    'Or Range("J9") = "" Or Range("J10") = "" Or Range("J11") = "" Or Range("J12") = "" Or Range("J13") = "" Or Range("J14") = "" Or Range("J15") = "" Or Range("J16") = "" Or Range("J17") = "" Or Range("J18") = "" Or Range("K9") = "" Or Range("k10") = "" Or Range("K11") = "" Or Range("K12") = "" Or Range("K13") = "" Or Range("K14") = "" Or Range("K15") = "" Or Range("K16") = "" Or Range("K17") = "" Or Range("K18") = "" _
    'Or Range("L9") = "" Or Range("L10") = "" Or Range("L11") = "" Or Range("L12") = "" Or Range("L13") = "" Or Range("L14") = "" Or Range("L15") = "" Or Range("L16") = "" Or Range("L17") = "" Or Range("L18") = "" Or Range("M9") = "" Or Range("M10") = "" Or Range("M11") = "" Or Range("M12") = "" Or Range("M13") = "" Or Range("M14") = "" Or Range("M15") = "" Or Range("M16") = "" Or Range("M17") = "" Or Range("M18") = "" Or Range("C7") = "" _
    'Or Range("N9") = "" Or Range("N10") = "" Or Range("N11") = "" Or Range("N12") = "" Or Range("N13") = "" Or Range("N14") = "" Or Range("N15") = "" Or Range("N16") = "" Or Range("N17") = "" Or Range("N18") = "" Or Range("O9") = "" Or Range("O10") = "" Or Range("O11") = "" Or Range("O12") = "" Or Range("O13") = "" Or Range("O14") = "" Or Range("O15") = "" Or Range("O16") = "" Or Range("O17") = "" Or Range("O18") = "" _
    'Or Range("P9") = "" Or Range("P10") = "" Or Range("P11") = "" Or Range("P12") = "" Or Range("P13") = "" Or Range("P14") = "" Or Range("P15") = "" Or Range("P16") = "" Or Range("P17") = "" Or Range("P18") = "" Or Range("Q9") = "" Or Range("Q10") = "" Or Range("Q11") = "" Or Range("Q12") = "" Or Range("Q13") = "" Or Range("Q14") = "" Or Range("Q15") = "" Or Range("Q16") = "" Or Range("Q17") = "" Or Range("Q18") = "" _
    'Or Range("R9") = "" Or Range("R10") = "" Or Range("R11") = "" Or Range("R12") = "" Or Range("R13") = "" Or Range("R14") = "" Or Range("R15") = "" Or Range("R16") = "" Or Range("R17") = "" Or Range("R18") = "" Or Range("S9") = "" Or Range("S10") = "" Or Range("S11") = "" Or Range("S12") = "" Or Range("S13") = "" Or Range("S14") = "" Or Range("S15") = "" Or Range("S16") = "" Or Range("S17") = "" Or Range("S18") = "" Or Range("T9") = "" Or Range("T10") = "" Or Range("T11") = "" Or Range("T12") = "" Or Range("T13") = "" Or Range("T14") = "" Or Range("T15") = "" Or Range("T16") = "" Or Range("T17") = "" Or Range("T18") = "" _
    'Or Range("U9") = "" Or Range("U10") = "" Or Range("U11") = "" Or Range("U12") = "" Or Range("U13") = "" Or Range("U14") = "" Or Range("U15") = "" Or Range("U16") = "" Or Range("U17") = "" Or Range("U18") = "" Or Range("V9") = "" Or Range("V10") = "" Or Range("V11") = "" Or Range("V12") = "" Or Range("V13") = "" Or Range("V14") = "" Or Range("V15") = "" Or Range("V16") = "" Or Range("V17") = "" Or Range("V18") = "" _
    'Or Range("W8") = "" Or Range("W9") = "" Or Range("W10") = "" Or Range("W11") = "" Or Range("W12") = "" Or Range("W13") = "" Or Range("W14") = "" Or Range("W15") = "" Or Range("W16") = "" Or Range("W17") = "" Or Range("W18") = "" Or Range("X8") = "" Or Range("X9") = "" Or Range("X10") = "" Or Range("X11") = "" Or Range("X12") = "" Or Range("X13") = "" Or Range("X14") = "" Or Range("X15") = "" Or Range("X16") = "" Or Range("X17") = "" Or Range("X18") = "" Or Range("Y8") = "" Or Range("Y9") = "" Or Range("Y10") = "" Or Range("Y11") = "" Or Range("Y12") = "" Or Range("Y13") = "" Or Range("Y14") = "" Or Range("Y15") = "" Or Range("Y16") = "" Or Range("Y17") = "" Or Range("Y18") = "" _
    'Or Range("Z9") = "" Or Range("Z10") = "" Or Range("Z11") = "" Or Range("Z12") = "" Or Range("Z13") = "" Or Range("Z14") = "" Or Range("Z15") = "" Or Range("Z16") = "" Or Range("Z17") = "" Or Range("Z18") = "" Or Range("AA9") = "" Or Range("AA10") = "" Or Range("AA11") = "" Or Range("AA12") = "" Or Range("AA13") = "" Or Range("AA14") = "" Or Range("AA15") = "" Or Range("AA16") = "" Or Range("AA17") = "" Or Range("AA18") = "" _
    'Or Range("AB9") = "" Or Range("AB10") = "" Or Range("AB11") = "" Or Range("AB12") = "" Or Range("AB13") = "" Or Range("AB14") = "" Or Range("AB15") = "" Or Range("AB16") = "" Or Range("AB17") = "" Or Range("AB18") = "" Then
    On Error GoTo 0
    If Not x Is Nothing Then
        MsgBox "â»Ã´ÃкآéÍÁÙÅãËé¤Ãº¶éǹ", vbCritical + vbOKOnly, "á¨é§àµ×͹"
        Exit Sub
    End If
Else
    Exit Sub
End If
Dim mylastrow As Long
With Worksheets("M1")
    mylastrow = Sheets("Add&out+PCR+Mortalityinmating").Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("B9:M18").Copy
    Sheets("Add&out+PCR+Mortalityinmating").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'    mylastrow = Sheets("Add&out+PCR+Mortalityinmating").Range("M" & Rows.Count).End(xlUp).Row + 1
    .Range("AB9:AB18").Copy
    Sheets("Add&out+PCR+Mortalityinmating").Range("M" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False

    mylastrow = Sheets("Feed+VCP+Formalin+Salt").Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("B9:E18").Copy
    Sheets("Feed+VCP+Formalin+Salt").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("Feed+VCP+Formalin+Salt").Range("E" & Rows.Count).End(xlUp).Row + 1
    .Range("N9:R18").Copy
    Sheets("Feed+VCP+Formalin+Salt").Range("E" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("Feed+VCP+Formalin+Salt").Range("J" & Rows.Count).End(xlUp).Row + 1
    .Range("AB9:AB18").Copy
    Sheets("Feed+VCP+Formalin+Salt").Range("J" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
       
    mylastrow = Sheets("Gravid+Spawning+Abort+Return ").Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("B9:E18").Copy
    Sheets("Gravid+Spawning+Abort+Return ").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("Gravid+Spawning+Abort+Return ").Range("E" & Rows.Count).End(xlUp).Row + 1
    .Range("S9:V18").Copy
    Sheets("Gravid+Spawning+Abort+Return ").Range("E" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("Gravid+Spawning+Abort+Return ").Range("I" & Rows.Count).End(xlUp).Row + 1
    .Range("AB9:AB18").Copy
    Sheets("Gravid+Spawning+Abort+Return ").Range("I" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False

    mylastrow = Sheets("water+Temp+DOC").Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("B9:E18").Copy
    Sheets("water+Temp+DOC").Range("A" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("water+Temp+DOC").Range("E" & Rows.Count).End(xlUp).Row + 1
    .Range("W9:AA18").Copy
    Sheets("water+Temp+DOC").Range("E" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
'        mylastrow = Sheets("water+Temp+DOC").Range("J" & Rows.Count).End(xlUp).Row + 1
    .Range("AB9:AB18").Copy
    Sheets("water+Temp+DOC").Range("J" & mylastrow).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, , False
    'Other code
End With
Dim lstRng As Range
Dim rng As Range, j As Integer
Dim r As Range
'    mylastrow = Sheets("reportM1").Range("M" & Rows.Count).End(xlUp).Row + 1
With Sheets("M1")
    With Sheets("ReportM1")
        Set lstRng = .Cells(8, .Columns.Count).End(xlToLeft).Offset(0, 1)
    End With
    j = 1
    For Each r In .Range("J9").Resize(10)
        lstRng.Offset(j, 0).Value = r.Value
        j = j + 2
    Next r
End With
'Other code

Code: Select all

Dim lstRng As Range
Dim rng As Range, j As Integer
Dim r As Range, c As Integer
With Sheets("M1")
    With Sheets("ReportM1")
        Set lstRng = .Cells(8, .Columns.Count).End(xlToLeft).Offset(0, 1)
    End With
    j = 1 'Paste on row 9
    c = 0
    For Each r In .Range("J9, l9")
        For Each rng In r.Resize(10)
            lstRng.Offset(j, c).Value = rng.Value
            j = j + 2
        Next rng
        j = 1
        c = c + 1
    Next r
     
    j = 0 'Paste in row 8
    c = 0
    For Each r In .Range("K9, M9")
        For Each rng In r.Resize(10)
            lstRng.Offset(j, c).Value = rng.Value
            j = j + 2
        Next rng
        j = 0
        c = c + 1
    Next r
End With

Code: Select all

Sub SaveM1_Click()
Dim x As Range
Dim answer As VbMsgBoxResult
answer = MsgBox("¤Ø³µéͧ¡Òúѹ·Ö¡¢éÍÁÙÅãªèËÃ×ÍäÁè", vbYesNo, "ºÑ¹·Ö¡¢éÍÁÙÅ")
If answer = vbYes Then
    On Error Resume Next
    Set x = Range("f9:ab18", "c7").SpecialCells(xlCellTypeBlanks)
       On Error GoTo 0
    If Not x Is Nothing Then
        MsgBox "â»Ã´ÃкآéÍÁÙÅãËé¤Ãº¶éǹ", vbCritical + vbOKOnly, "á¨é§àµ×͹"
    Exit Sub
    End If
Else
    Exit Sub

Code: Select all

Sub SaveM1_Click()
Dim x As Range
Dim answer As VbMsgBoxResult
answer = MsgBox("¤Ø³µéͧ¡Òúѹ·Ö¡¢éÍÁÙÅãªèËÃ×ÍäÁè", vbYesNo, "ºÑ¹·Ö¡¢éÍÁÙÅ")
If answer = vbYes Then
    On Error Resume Next
    Set x = Range("f9:ab18", "c7").SpecialCells(xlCellTypeBlanks)
       On Error GoTo 0
    If Not x Is Nothing Then
        MsgBox "â»Ã´ÃкآéÍÁÙÅãËé¤Ãº¶éǹ", vbCritical + vbOKOnly, "á¨é§àµ×͹"
    Exit Sub
    End If
Else
    Exit Sub

Code: Select all

j = 1 'Paste on row 9
    c = 0
    For Each r In .Range("J9, L9")
        For Each rng In r.Resize(10)
            lstRng.Offset(j, c).Value = rng.Value
            j = j + 2
        Next rng
        j = 1
        c = c + 1
    Next r