0

I'm trying to write in an Excel sheet with a VBA macro. After I open a workbook with:

Set wrk=open ("C:/text.xlsx")

I find last non empty cell in a column "B", for example with:

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

then I write one with:

cell(LastRow,2) =1

but when I want to write in column "D" the same way:

LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
cell(lastRow,4)=1

the macro writes one in the same row as the first one, knowing that the last non empty cell in column "B" and column "D" are not the same.

I wrote:

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False

before opening the Excel sheet to make the macro faster.

Mycode:

Option Explicit
Private Sub maac() ' fonction de décharge de questionnaire type Compostage

Dim src_path, distination_Path As String
Dim source, distination As String 'workbooks
Dim src_feuil, via, distination_feuil As String 'sheets
Dim src_cell_address As String ' adresses
Dim count, countB, last_via_cell, distination_col_address As Integer
Dim last_dist_row As Long
Dim dist_path_fname As String
Dim co, wrk As Workbook

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False

'Desactive les alerts et les mises à jour écran
'App_prop.app_disable
 Set co = ThisWorkbook
 via = ActiveSheet.Name 'activated Via worksheet
last_via_cell = Sheets(via).UsedRange.Rows.count
'MsgBox ActiveSheet.Name ' nom de la feuil active
'MsgBox Sheets(via).Cells(1, 1).Address(RowAbsolute:=False,     ColumnAbsolute:=False)

src_path = Sheets(via).Cells(2, 1).Value
source = "src.xlsx"
src_feuil = Sheets(via).Cells(2, 3).Value
src_cell_address = Sheets(via).Cells(Sheets(via).Cells(2, 6).Value, Sheets(via).Cells(2, 7).Value).Address

distination_Path = Sheets(via).Cells(2, 9) ' path of source file (questionnaire) bdd file path
distination = Sheets(via).Cells(2, 8)  ' name of bdd file
distination_feuil = Sheets(via).Cells(2, 10) ' name of sheet of bdd file
distination_col_address = Sheets(via).Cells(2, 12)

'DoEvents

Set wrk = Workbooks.Open(distination_Path & "\" & distination & ".xlsx")
'Application.ScreenUpdating = False
last_dist_row = wrk.Sheets(distination_feuil).Cells(Rows.count,  distination_col_address).End(xlUp).Row + 1
MsgBox last_dist_row
wrk.Sheets(distination_feuil).Cells(last_dist_row, distination_col_address) = GetValue(src_path, source, src_feuil, src_cell_address) 'GET VALUE


For count = 3 To last_via_cell

'---- SOURCE COORDINATIONS
'Workbooks("C:\Users\pc\Desktop\comp.xlsm").Sheets("Compostage").Activate
src_path = co.Sheets(via).Cells(count, 1) ' path of source file (questionnaire)
 source = "src.xlsx" ' name of source file (questionnaire)
src_feuil = co.Sheets(via).Cells(count, 3) ' name of source file sheet (questionnaire)
src_cell_address = co.Sheets(via).Cells(co.Sheets(via).Cells(count, 6).Value, co.Sheets(via).Cells(count, 7).Value).Address

'----- BDD COORDINATIONS
distination_Path = co.Sheets(via).Cells(count, 9) ' path of source file (questionnaire) 'bdd file path
distination = co.Sheets(via).Cells(count, 8)  ' name of bdd file
distination_feuil = co.Sheets(via).Cells(count, 10) ' name of sheet of bdd file
distination_col_address = co.Sheets(via).Cells(count, 12)
MsgBox "col" & distination_col_address


If co.Sheets(via).Cells(count, 8) <> co.Sheets(via).Cells(count - 1, 8) Then
wrk.Save
wrk.Close
Set wrk = Nothing
Set wrk = Workbooks.Open(distination_Path & "\" & distination & ".xlsx")
last_dist_row = wrk.Sheets(distination_feuil).Cells(Rows.count,   distination_col_address).End(xlUp).Row + 1 ' get the last empty row in BDD
'MsgBox "row" & last_dist_row
wrk.Sheets(distination_feuil).Cells(last_dist_row, distination_col_address) = GetValue(src_path, source, src_feuil, src_cell_address) 'get value
Else
'--------------------------OPEN
'last_dist_row =wrk.Sheets(distination_feuil).Range("A1").End(xlDown).Row + 1  get the last empty row in BDD
last_dist_row = wrk.Sheets(distination_feuil).Cells(Rows.count, distination_col_address).End(xlUp).Row + 1
wrk.Sheets(distination_feuil).Cells(last_dist_row, distination_col_address) =    GetValue(src_path, source, src_feuil, src_cell_address) 'GET VALUE
End If
Next count
wrk.Save
wrk.Close
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
End Sub
Private Function GetValue(path, file, sheet, ref)
  'Retrieves a value from a closed workbook
    Dim arg As String
'   Make sure the file exists
    If Right(path, 1) <> "\" Then path = path & "\"
    If Dir(path & file) = "" Then
        GetValue = "File Not Found"
        Exit Function
    End If
'   Create the argument
    arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
      Range(ref).Range("A1").Address(, , xlR1C1)
'   Execute an XLM macro
If ExecuteExcel4Macro(arg) = 0 Then
    GetValue = ""
    Else: GetValue = ExecuteExcel4Macro(arg)
    End If
End Function
Community
  • 1
  • 1
Hsimo
  • 1
  • 2
  • It would help to post your code formatted neatly so people can follow. look at : http://stackoverflow.com/questions/15500552/vba-for-excel-2010-2013-how-to-identify-the-system-locale – Solar Mike May 15 '17 at 08:34
  • ok i'll thanks ! – Hsimo May 18 '17 at 13:33

0 Answers0