Can't run multiple macros but alone they work

[elementqka]

Hi,

I have a first macro that compile data using relative and absolute reference recording.

My second macro consolidate data

My third macro clean the table after the consolidation.

I can run them fine alone but one after the other one its not working.

Call doesnt work. Application wait doesnt really work ...


First macro :

Sub XX()
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate

If InStr(1, ws.Name, "XXXX") > 0 And Range("C10").Value = "XXXX" Then


If Range("J17").Value <> "" Then

Sheets(ws.Name).Select


Range("C25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tableau enrobé").Select
Range("M4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M4").Select

End If

GoTo ReStart:

End If

ReStart:

Next ws


End Sub


Second macro :

Sub merge()

Dim lastRow As Long, iCntr As Long, rngDel As Range, dict As Object, yo As Range, iCntr2 As Long

Application.ScreenUpdating = False

lastRow = Range("B" & Rows.Count).End(xlUp).Row

Set dict = CreateObject("Scripting.Dictionary")

For iCntr = 6 To lastRow

If Cells(iCntr, 2) <> "" Then

If Not dict.Exists(Cells(iCntr, 2).Value) Then

dict.Add Cells(iCntr, 2).Value, iCntr

Else

Range("C" & dict(Cells(iCntr, 2).Value) & ":M" & dict(Cells(iCntr, 2).Value)).Value = _
Range("C" & iCntr & ":M" & iCntr).Value

If rngDel Is Nothing Then


Set rngDel = Cells(iCntr, 2)
Set yo = Cells(iCntr, 2)

Else

Set rngDel = Union(rngDel, Cells(iCntr, 2))


End If


End If

End If


Next
End Sub

Third macro :


Sub clean()

Dim lastRow As Long
Dim myRow As Long

Dim lastRow2 As Long
Dim myRow2 As Long


Application.ScreenUpdating = False


lastRow = Cells(150, "B").End(xlUp).Row
lastRow2 = Cells(150, "AA").End(xlUp).Row


For myRow = lastRow To 6 Step -1


If Cells(myRow, "B") = Cells(myRow - 1, "B") Then


For myRow2 = lastRow2 To 6 Step -1

If Cells(myRow2, "AA") = " " Then


Rows(myRow2).Delete

End If

Next myRow2

End If



Next myRow



End Sub



Thank you !

 

[BSALV]

i think if the last worksheet had a matching J17 then your activesheet is "Tableau enrobé"), otherwise the last worksheet.
so be sure that you're also work in the desired worksheet, which is that tableau enrobé.
Activate and select are commands to avoid, they slow down your colde and are unnecessary.

It's better to work with variables, like
set shT=Sheets("Tableau enrobé")
or
with Sheets("Tableau enrobé")
....
end with

 

[rlv01]

Your code uses many unqualified range and cell references, which means that if the active sheet ( ActiveSheet) is not as you expect, your code will go wrong. This is almost certainly what is going wrong when you try to run all macros one after the other. The quickest way to fix that is to put a line of code

    'Define the active worksheet
    Worksheets("Tableau enrobé").Select '<--- add code to select a worksheet

at the top of the second and third macros to select the worksheet those macros should run on. In my example, I chose Worksheets("Tableau enrobé"), but that's only a guess. You must choose the correct worksheet.

'Second macro:
Sub merge()
    Dim lastRow As Long, iCntr As Long, rngDel As Range, dict As Object, yo As Range, iCntr2 As Long
    Application.ScreenUpdating = False
      
    'Define the active worksheet
    Worksheets("Tableau enrobé").Select '<--- add code to select a worksheet
    
    lastRow = Range("B" & Rows.Count).End(xlUp).Row
    Set dict = CreateObject("Scripting.Dictionary")
    For iCntr = 6 To lastRow
        If Cells(iCntr, 2) <> "" Then
            If Not dict.Exists(Cells(iCntr, 2).Value) Then
                dict.Add Cells(iCntr, 2).Value, iCntr
            Else
                Range("C" & dict(Cells(iCntr, 2).Value) & ":M" & dict(Cells(iCntr, 2).Value)).Value = _
                Range("C" & iCntr & ":M" & iCntr).Value
                If rngDel Is Nothing Then
                    Set rngDel = Cells(iCntr, 2)
                    Set yo = Cells(iCntr, 2)
                Else
                    Set rngDel = Union(rngDel, Cells(iCntr, 2))
                End If
            End If
        End If
    Next
End Sub

'Third macro:
Sub clean()
    Dim lastRow As Long
    Dim myRow As Long
    Dim lastRow2 As Long
    Dim myRow2 As Long
    Application.ScreenUpdating = False
    
    'Define the active worksheet
    Worksheets("Tableau enrobé").Select '<--- add code to select a worksheet
        
    
    lastRow = Cells(150, "B").End(xlUp).Row
    lastRow2 = Cells(150, "AA").End(xlUp).Row
    For myRow = lastRow To 6 Step -1
        If Cells(myRow, "B") = Cells(myRow - 1, "B") Then
            For myRow2 = lastRow2 To 6 Step -1
                If Cells(myRow2, "AA") = " " Then
                    Rows(myRow2).Delete
                End If
            Next myRow2
        End If
    Next myRow
End Sub

(Tip: when posting code, please try to use 'code tags' to format the code as I have done above

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

 

[elementqka]

Thank you rlv01 !