Snasui Excel Forum

Code: Select all

Private Sub CommandButton1_Click()
   ActiveSheet.Range("A2", _
   ActiveSheet.Range("A2").End(xlDown).End(xlToRight)).Select
    Selection.ClearContents
    Dim wb1 As Variant
    Application.DisplayAlerts = False
    Set wb1 = Workbooks.Open("D:\My Documents\Desktop\db1.xlsx", False, False)
    Windows("db1.xlsx").Activate
    ActiveSheet.Range("A2", _
   ActiveSheet.Range("A2").End(xlDown).End(xlToRight)).Select
    Selection.Copy
    Windows("db.xlsm").Activate
   Range("A65000").End(xlUp).Offset(1, 0).Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     wb1.Close True
    MsgBox ("บันทึกเสร็จแล้ว")
End Sub

Code: Select all

Private Sub CommandButton1_Click()
    ActiveSheet.Range("A2", _
    ActiveSheet.Range("A2").End(xlDown).End(xlToRight)).Select
    Selection.ClearContents
    Dim wb1 As Variant
    Application.DisplayAlerts = False
    For Each r In Range("z1:z100")
        Set wb1 = Workbooks.Open("D:\My Documents\Desktop\" & r & ".xlsx", False, False)
        Windows(wb1).Activate
        ActiveSheet.Range("A2", _
        ActiveSheet.Range("A2").End(xlDown).End(xlToRight)).Select
        Selection.Copy
        Windows("db.xlsm").Activate
        Range("A65000").End(xlUp).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
         wb1.Close True
    Next r
    MsgBox ("Finish')
End Sub

Code: Select all

    ActiveSheet.Range("A2", _
        ActiveSheet.Range("IV" & ActiveSheet.Range("A" & Rows.Count) _
        .End(xlUp).Row).End(xlToLeft)).Select
    Selection.Copy

Code: Select all

Range("A65000").End(xlUp).Offset(1, 0).Select

Code: Select all

Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select

Code: Select all

Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select

Code: Select all

'Other code
If Worksheets("Record").Range("A2") = vbNullString Then
    MsgBox ("File db no data")
    wb.Close True
Else
    ActiveSheet.Range("A2", _
    ActiveSheet.Range("IV" & ActiveSheet.Range("A" & Rows.Count) _
        .End(xlUp).Row).End(xlToLeft)).Select
    Selection.Copy
    Windows("db.xlsm").Activate
    Sheets("Sheet1").Select
    Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    wb.Close True
End If
'Other code

Code: Select all

Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).Select

Code: Select all

Private Sub CommandButton1_Click()
    Dim wb As Workbook
    Dim currBook As Workbook
    Set currBook = Workbooks("db.xlsm")
    With currBook.Sheets("Sheet1")
        .Range("A2", .Range("A2").End(xlDown).End(xlToRight)).ClearContents
    End With
    'db copy
    Application.DisplayAlerts = False
    Set wb = Workbooks.Open("D:\My Documents\Desktop\db.xlsx", False, False)
    If wb.Sheets("Record").Range("A2") = "" Then
        MsgBox "File db no data"
    Else
        With wb.Worksheets("Record")
            .Range("A2", .Range("IV" & .Range("A" & Rows.Count) _
                .End(xlUp).Row).End(xlToLeft)).Copy
        End With
        currBook.Sheets("Sheet1").Range("a" & Rows.Count) _
            .End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    End If
    wb.Close True
End Sub