abracadabra ma feuille a disparu

[alexistak]

J'ai une macro qui me fait un reporting.
Elle est sensee me rendre le rapport en sheet2
Avant elle ouvrait une autre fenetre excel pour faire ce rapport, j'ai modifier la macro pour qu'elle me fasse ce rapport en sheet2.
et oh magie, je n'ai rien et pourtant, les donnees sont importees sans problemes....
Ca vient d'ou?

'~~~~~~Sub to adjust row heigth and column width of Full Limit Violation~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub Main1()

'***Variables***
Dim GCCReport As Workbook                               'Workbook of report from GCC
Dim row_count As Integer                                'Counter for no of rows in GCC Report

''Delete data written in last import
'Workbooks("GCC Violation ReportALL.xls").Worksheets("Start").Range("D32").ClearContents
Workbooks("GCC Violation ReportALL.xls").Worksheets("Sheet2").Range("B4:Q23000").Delete

'opens dialog box to choose report
Filename = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
    If Filename = False Then
        ' They pressed Cancel
        MsgBox "Stopping because you did not select a file"
        Exit Sub
    Else
        Workbooks.Open (Filename)
        Set GCCReport = ActiveWorkbook
        
'        w_rows = DataExtract
        
 

        GCCReport.Close
        
        End If

MsgBox "Data Import has finished"

Workbooks("GCC Violation ReportALL.xls").Worksheets(2).Activate
row_count = RowCount

    
    With Workbooks("GCC Violation ReportALL.xls").Worksheets(2)


        'adjust column width
        .Columns("A").ColumnWidth = 0
        .Columns("B").ColumnWidth = 10
        .Columns("C").ColumnWidth = 10
        .Columns("D").ColumnWidth = 15
        .Columns("E").ColumnWidth = 15
        .Columns("F").ColumnWidth = 15
        .Columns("G").ColumnWidth = 25
        .Columns("H").ColumnWidth = 15
        .Columns("I").ColumnWidth = 2
        .Columns("J:L").ColumnWidth = 4
        .Columns("J:L").HorizontalAlignment = xlCenter
        .Columns("M").ColumnWidth = 4
        .Columns("N").ColumnWidth = 25
        .Columns("O").ColumnWidth = 20
        .Columns("P").ColumnWidth = 7


        'adjust row heigth
        .Rows("4:20000").AutoFit

        'Set Borders for Cells
        .Range(Worksheets("Sheet2").Cells(4, 1), Worksheets("Sheet2").Cells(row_count, 17)).Borders.Weight = xlHairline
        .Range(Worksheets("Sheet2").Cells(4, 1), Worksheets("Sheet2").Cells(row_count, 17)).Borders.Color = RGB(0, 0, 0)
        .Range(Worksheets("Sheet2").Cells(4, 1), Worksheets("Sheet2").Cells(row_count, 17)).Borders.LineStyle = xlContinuous
        .Range("A3:Q3").Borders.LineStyle = xlContinuous
        .Range("A3:Q3").Borders.Weight = xlHairline
        .Range("A3:Q3").Borders.Color = RGB(0, 0, 0)

       End With


Call ColorUPC(4, row_count, 17)
Call SeperateUPC(4, row_count, 17)
Call PrintSetup(65, 2)

End Sub








'~~~~~~~~~~~~~~~~~Function to count rows in GCCReports~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function RowCount() As Integer

Dim m As Integer            'Loop Counter
m = 6
Do While (Workbooks("GCC Violation ReportALL.xls").Worksheets(2).Cells(m, 7).Value <> 0)
'Do While (ActiveWorkbook.Worksheets("Sheet2").Cells(m, 7).Value <> 0)

m = m + 1
Loop

RowCount = m - 1

End Function

'~~~~~~~~~~~~~~~~~~~Sub to color UPCs in order to separate them~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Arguments~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'start_row              specifies where to start the separation of UPCs
'row_max                row in which to end sub
'col_max                column until which background color should be changed
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'uses UPC as reference to sort


Sub ColorUPC(start_row As Integer, row_max As Integer, col_max As Integer, Optional comp_row As Integer = 6)

Dim i As Integer
i = start_row
marker = 0
'MsgBox row_max

Do While (i <= row_max)

If Worksheets("Sheet2").Cells(i, comp_row + 1) <> Worksheets("Sheet2").Cells(i - 1, comp_row + 1) Then
    
    With Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(i, 1), Worksheets("Sheet2").Cells(i, col_max)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .Color = RGB(0, 0, 0)
    End With
    
    marker = marker + 1
    'MsgBox "Marker  " & marker & " Loop counter  " & i
End If

If (marker Mod 2 = 0) Then
    Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(i, 1), Worksheets("Sheet2").Cells(i, col_max)).Interior.Color = RGB(255, 228, 181)
End If


i = i + 1
Loop

End Sub

Sub PrintSetup(resize As Double, sheet As Integer)

Dim Run As Boolean

Run = Application.Dialogs(xlDialogPrinterSetup).Show
    
If Run = False Then
MsgBox "Stopping Print Setup since no printer was chosen"
Exit Sub
Else
    '************Page Setup***************
    With Workbooks("GCC Violation ReportALL.xls").Worksheets(Sheet2).PageSetup
        '.PaperSize = xlPaperA3
        .Zoom = resize
        .Orientation = xlLandscape
        .TopMargin = 0.5
        .BottomMargin = 0.5
        .RightMargin = 0.5
        .LeftMargin = 0.5
        '.PrintArea = "A1:AR10"
    End With
   
Application.Dialogs(xlDialogPrintPreview).Show
End If
'    '************Print Dialog***********
'    ActiveWorkbook.Worksheets(1).PrintOut
        
End Sub

'uses UPC as reference to sort

Sub SeperateUPC(start_row As Integer, row_max As Integer, col_max As Integer, Optional comp_row As Integer = 6, Optional del As Boolean = True)

Dim i As Integer
i = start_row
before = Worksheets("Sheet2").Cells(i - 1, comp_row)

Do While (i <= row_max)
    
    If Worksheets("Sheet2").Cells(i, comp_row) = before Then
    
    before = Worksheets("Sheet2").Cells(i, comp_row)
    
    If del = True Then
    Worksheets("Sheet2").Cells(i, comp_row).ClearContents
    End If
    
    Worksheets("Sheet2").Cells(i, comp_row).ClearContents
    
    
    
    Else
    
    before = Worksheets("Sheet2").Cells(i, comp_row)
    
    End If
    
    i = i + 1
    
Loop

End Sub

Merci de votre aide