Snasui Excel Forum

Code: Select all

Sub Recdata()
    Application.ScreenUpdating = False
    
    Dim rh As Range, rd As Range, rd1 As Range
    Dim lr As Long
    Application.ScreenUpdating = False
    With Worksheets("Report")
        Set rh = Application.Union(.Range("d4"), .Range("g4"))
        lr = .Range("c" & .Rows.Count).End(xlUp).Row
        Set rd = .Range("b20:c" & lr)
        Set rd1 = .Range("e20:h" & lr)
    End With
    With Worksheets("All")
        rh.Copy
        .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(rd.Rows.Count, 2) _
            .PasteSpecial xlPasteValues
        rd.Copy
        .Range("c" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(rd.Rows.Count, 2) _
            .PasteSpecial xlPasteValues
        rd1.Copy
        .Range("e" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(rd.Rows.Count, 4) _
            .PasteSpecial xlPasteValues
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
End Sub

Code: Select all

Dim rh As Range, rd As Range
Dim lr As Long
With Worksheets("Report")
    Set rh = Application.Union(.Range("d4"), .Range("g4"))
    lr = .Range("c" & .Rows.Count).End(xlUp).Row
    Set rd = Application.Union(.Range("b20:c" & lr), .Range("e20:h" & lr))
End With
With Worksheets("All")
    rh.Copy
    .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(rd.Rows.Count, 2) _
        .PasteSpecial xlPasteValues
    rd.Copy
    .Range("c" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(rd.Rows.Count, 5) _
        .PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False

Code: Select all

With Worksheets("Report")
    If Application.countifs(Worksheets("All2").Range("a:a"), .Range("d4")) > 0 Then
        MsgBox ("ข้อมูลซ้ำ")
    Exit Sub
    End If
End With

Code: Select all

Sub RecCol()
Application.ScreenUpdating = False
Dim ra As Range, r As Range
Dim l As Long, i As Integer

With Worksheets("All2")
    if Application.countifs(worksheets("All2").range("a:a"),.range("d4") > 0 Then
        MsgBox ("ข้อมูลซ้ำ")
    Exit Sub
    End If
End With
 
With Worksheets("Report")
    If Range("d4").Value = "" Then
        MsgBox ("ยังไม่กรอกเลขที่บันทึก")
        Exit Sub
    End If
    Set ra = .Range("D4,G4,D6,G6,D8,D10,G10,D12,G12,H12,D14,E14,G14,H14,E16,G16")
End With
With Worksheets("All2")
    l = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
    For Each r In ra
        .Range("a" & l).Offset(0, i).Value = r.Value
        i = i + 1
    Next r
End With
        Application.ScreenUpdating = True
End Sub

Code: Select all

 if Application.countifs(worksheets("All2").range("a:a"),.range("d4") > 0 Then

Code: Select all

With Worksheets("All2")
	if .range("d4").value = "" then
		'Your message
	end if

	if Application.countifs(worksheets("Report").range("a:a"),.range("d4") > 0 Then
		'Your message
	end if
	'Other code
End With

Code: Select all

Dim ra As Range, r As Range
Dim l As Long, i As Integer
With Worksheets("Report")
    Set ra = .Range("D4,G4,D6,G6,D8,D10,G10,D12,G12,H12,D14,E14,G14,H14,E16,G16")
End With
With Worksheets("All2")
    l = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
    For Each r In ra
        .Range("a" & l).Offset(0, i).Value = r.Value
        i = i + 1
    Next r
End With

Code: Select all

Dim ra As Range, r As Range
Dim l As Long, i As Integer
With Worksheets("Report")
    Set ra = .Range("D4,G4,D6,G6,D8,D10,G10,D12,G12,H12,D14,E14,G14,H14,E16,G16")
End With
With Worksheets("All2")
    l = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
    For Each r In ra
        .Range("a" & l).Offset(0, i).Value = r.Value
        i = i + 1
    Next r
End With

Code: Select all

Sub RecCol()
Application.ScreenUpdating = False

    Range("D4").Select
    Selection.Copy
    Sheets("All2").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Report").Select
    Range("G4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("All2").Select
    Application.CutCopyMode = False
    Sheets("All2").Move Before:=Sheets(2)
    Sheets("Report").Select
    Range("D6").Select
    Selection.Copy
    Sheets("All2").Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D2").Select
    Sheets("Report").Select
    Range("G6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E2").Select
    Sheets("Report").Select
    Range("D8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F2").Select
    Sheets("Report").Select
    Range("D10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Report").Select
    Range("G10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Report").Select
    Range("D12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Range("H2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Report").Select
    Range("G12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Range("I2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J2").Select
    Sheets("Report").Select
    Range("H12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K2").Select
    Sheets("Report").Select
    Range("D14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L2").Select
    Sheets("Report").Select
    Range("E14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("M2").Select
    Sheets("Report").Select
    Range("G14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("N2").Select
    Sheets("Report").Select
    Range("H14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Report").Select
    Range("E16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Range("O2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Report").Select
    Range("G16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("All2").Select
    Range("P2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.ScreenUpdating = True

End Sub

Code: Select all

Dim rh As Range, rd As Range
Dim lr As Long
With Worksheets("Report")
    Set rh = Application.Union(.Range("d4"), .Range("g4"))
    lr = .Range("c" & .Rows.Count).End(xlUp).Row
    Set rd = Application.Union(.Range("b20:c" & lr), .Range("e20:h" & lr))
End With
With Worksheets("All")
    rh.Copy
    .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(rd.Rows.Count, 2) _
        .PasteSpecial xlPasteValues
    rd.Copy
    .Range("c" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(rd.Rows.Count, 5) _
        .PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False

Code: Select all

Sub RecData()
Application.ScreenUpdating = False
    Range("D4").Select
    Selection.Copy
    Sheet28.Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheet27.Select
    Range("G4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheet28.Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheet27.Select
    Range("B20:C56,E20:H56").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheet28.Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Range("C2").Select
            Sheet27.Select
        Application.CutCopyMode = False
           Range("D4").Select
           Application.ScreenUpdating = False

End Sub