hi all,
i have a worksheet with a macro,that creates a sheet and sorts the data and enters in the newly created sheet
when the datas are entered in the sheet,i find that the values that has to be filled in the first row is filled in the 20th row skipping few rows.
i ran this macro lastweek, the output was fine but now i find its wrong.
somebody please gothrough my excel sheet and the macro and let me knoww why the output is not as desired.
is it possible to attach the worksheet?
i cannot find the attachment option, please let me know where it is, so that i can attach the file.
thanks in advance
i have a worksheet with a macro,that creates a sheet and sorts the data and enters in the newly created sheet
when the datas are entered in the sheet,i find that the values that has to be filled in the first row is filled in the 20th row skipping few rows.
i ran this macro lastweek, the output was fine but now i find its wrong.
somebody please gothrough my excel sheet and the macro and let me knoww why the output is not as desired.
Code:
Sub Create()
Dim wSheet As Worksheet
Dim active_sheet, target_sheet
Dim ligne, count, ligne_liste As Integer
Dim cell_depend, cell_dnf, cell_rep_asm, cell_rep_dnf, cell_qte, cell_nom As String
Dim cell_aec_std_des_fr, cell_aww_free_des, cell_aec_free_des_en As String
Dim cell_aec_ecn, cell_fra_issue, cell_fra_ecn_d, cell_fra_key_car As String
Dim cell_dev_status, cell_designer, cell_comp As String
Dim cellule1, cellule2, cellule3, cellule4, cellule5, cellule6, cellule7 As String
Dim cellule8, cellule9, cellule10, cellule11, cellule12, cellule13, cellule14 As String
Dim cellule15, cellule16, cellule17 As String
Dim parent(1000) As Variant
ligne = 1
ligne_liste = 1
active_sheet = "Ecn_Intralink"
target_sheet = "Intralink_Bom"
return_sheet = "Home"
On Error Resume Next
Set wSheet = Sheets(target_sheet)
If Not wSheet Is Nothing Then
Sheets(target_sheet).Delete
On Error GoTo 0
End If
Sheets.Add.Name = target_sheet
Sheets(target_sheet).Columns("A:E").NumberFormat = "@"
Sheets(active_sheet).Select
While (ActiveSheet.Cells(ligne, 1).Value) > 0
cell_nom = ActiveSheet.Cells(ligne, 2).Value
If Not (cell_nom Like "*_*" Or cell_nom Like "Nom") Then
cell_depend = ActiveSheet.Cells(ligne, 1).Value
' ligne 2 cell_nom
cell_comp = ActiveSheet.Cells(ligne, 3).Value
cell_qte = ActiveSheet.Cells(ligne, 4).Value
cell_aec_std_des_fr = ActiveSheet.Cells(ligne, 5).Value
cell_aec_free_des_fr = ActiveSheet.Cells(ligne, 6).Value
cell_aww_std_des = ActiveSheet.Cells(ligne, 7).Value
cell_aec_free_des_en = ActiveSheet.Cells(ligne, 8).Value
cell_aec_ecn = ActiveSheet.Cells(ligne, 9).Value
cell_fra_issue = ActiveSheet.Cells(ligne, 10).Value
cell_fra_ecn_d = ActiveSheet.Cells(ligne, 11).Value
cell_dnf = ActiveSheet.Cells(ligne, 12).Value
cell_fra_key_car = ActiveSheet.Cells(ligne, 13).Value
cell_dev_status = ActiveSheet.Cells(ligne, 14).Value
cell_rep_asm = ActiveSheet.Cells(ligne, 15).Value
cell_rep_dnf = ActiveSheet.Cells(ligne, 16).Value
cell_designer = ActiveSheet.Cells(ligne, 17).Value
count = Len(RTrim(LTrim(cell_depend))) - 3
If Not cell_depend Like "*(*" Then
If count = 1 Then
parent(0) = "PARENT"
End If
If cell_nom Like "01*asm" Then
parent(count) = StrConv(Left(cell_nom, Len(cell_nom) - 4), 1)
Else
parent(count) = StrConv(Left(cell_nom, Len(cell_nom) - 4) & cell_comp, 1)
End If
End If
cellule1 = parent(count - 1)
If cellule1 = "PARENT" Then
cellule2 = "ENFANT"
cellule3 = "QTE"
cellule4 = "STD_DES_FR"
cellule5 = "FREE_DES_FR"
cellule6 = "STD_DES_EN"
cellule7 = "FREE_DES_EN"
cellule8 = "AEC_ECN"
cellule9 = "FRA_ISSUE"
cellule10 = "FRA_ECN_D"
cellule11 = "DNF"
cellule12 = "FRA_KEY_CAR"
cellule13 = "DEV_STATUS"
cellule14 = "REP_ASM"
cellule15 = "REP_DNF"
cellule16 = "DESIGNER"
Else
If ((cell_nom Like "*X*") Or (cell_nom Like "*x*")) Then
cellule2 = StrConv(Left(cell_nom, Len(cell_nom) - 4), 1)
Else
cellule2 = StrConv(Left(cell_nom, Len(cell_nom) - 4) & cell_comp, 1)
End If
cellule3 = cell_qte
cellule4 = cell_aec_std_des_fr
cellule5 = cell_aec_free_des_fr
cellule6 = cell_aww_std_des
cellule7 = cell_aec_free_des_en
cellule8 = cell_aec_ecn
cellule9 = cell_fra_issue
cellule10 = cell_fra_ecn_d
cellule11 = "DNF " & cell_dnf
cellule12 = cell_fra_key_car
cellule13 = cell_dev_status
cellule14 = cell_rep_asm
cellule15 = cell_rep_dnf
cellule16 = cell_designer
End If
Worksheets(target_sheet).Cells(ligne_liste, 1) = cellule1
Worksheets(target_sheet).Cells(ligne_liste, 2) = cellule2
Worksheets(target_sheet).Cells(ligne_liste, 3) = cellule3
Worksheets(target_sheet).Cells(ligne_liste, 4) = cellule4
Worksheets(target_sheet).Cells(ligne_liste, 5) = cellule5
Worksheets(target_sheet).Cells(ligne_liste, 6) = cellule6
Worksheets(target_sheet).Cells(ligne_liste, 7) = cellule7
Worksheets(target_sheet).Cells(ligne_liste, 8) = cellule8
Worksheets(target_sheet).Cells(ligne_liste, 9) = cellule9
Worksheets(target_sheet).Cells(ligne_liste, 10) = cellule10
Worksheets(target_sheet).Cells(ligne_liste, 11) = cellule11
Worksheets(target_sheet).Cells(ligne_liste, 12) = cellule12
Worksheets(target_sheet).Cells(ligne_liste, 13) = cellule13
Worksheets(target_sheet).Cells(ligne_liste, 14) = cellule14
Worksheets(target_sheet).Cells(ligne_liste, 15) = cellule15
Worksheets(target_sheet).Cells(ligne_liste, 16) = cellule16
ligne_liste = ligne_liste + 1
End If
ligne = ligne + 1
Wend
Sheets(target_sheet).Cells.EntireColumn.AutoFit
Sheets(target_sheet).Move After:=Sheets(2)
Sheets(return_sheet).Select
End Sub
is it possible to attach the worksheet?
i cannot find the attachment option, please let me know where it is, so that i can attach the file.
thanks in advance