How to add data daily on the first blank line? Canteen example

Silva 0
Viewed 36

I have the following set of code to record daily employees who eat lunch in the canteen. What change is needed so that when the person clicks on the macro button every day, the data is on the 1st blank line (from column A) of the "dados_diarios" sheet? This is so that at the end of the month I have a list of all the days.

Sub outros_diario()

Sheets("outros").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select

Workbooks.Open ("N:\RH\Cantina\Lista_OUTROS.xlsx")
Windows("Lista_OUTROS.xlsx").Activate
Cells.Select
Selection.Copy
Windows("outros.xlsm").Activate
Sheets("outros").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
ActiveWindow.DisplayGridlines = False

Range("B8:O1000").Select
Selection.Copy

Sheets("dados_diarios").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("C2:F1000").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("E2:H1000").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Range("H8").Select
Columns("C:C").EntireColumn.AutoFit


End Sub
dataset vba excel
1 Answers

Give this a go. You may want to add back in your DisplayGridlines= False and the deletion of cells at the end - but it should give you a much better start than where you're up to right now:

Sub outros_diario()

    'declarations
    Dim last_row_source As Long
    Dim last_row_destination As Long
    Dim source_book As Workbook
    Dim source_sheet As Worksheet
    Dim dest_sheet1 As Worksheet
    Dim dest_sheet2 As Worksheet
    
    'set references to the two paste destinations
    Set dest_sheet1 = ThisWorkbook.Sheets("outros")
    Set dest_sheet2 = ThisWorkbook.Sheets("dados_diarios")
    
    'delete-clear sheet: outros
    dest_sheet1.Cells.Delete Shift:=xlUp
    
    'open the workbook as reference 'source_book'
    Set source_book = Workbooks.Open("N:\RH\Cantina\Lista_OUTROS.xlsx")
    
    'set a reference to the activesheet and call it 'source_sheet'
    Set source_sheet = source_book.ActiveSheet
    
    'copy source_sheet to dest_sheet1 [outros]
    source_sheet.Cells.Copy dest_sheet1.Range("A1")
    
    'find where the data now stops on the [outros]
    last_row_source = dest_sheet1.Cells(dest_sheet1.Rows.Count, "B").End(xlUp).Row
    
    'find where the data stops on [dados_diarios]
    last_row_destination = dest_sheet2.Cells(dest_sheet2.Rows.Count, "B").End(xlUp).Row
    
    'copy data values from [outros] to [dados_diarios] ignoring first 7 rows
    dest_sheet2.Range("A" & last_row_destination + 1).Resize(last_row_source - 7, 14).Value = dest_sheet1.Range("B8:O" & last_row_source).Value
    
    'close the source workbook, without saving
    source_book.Close False

End Sub
CLR0
Related