none
Macro not working RRS feed

  • Question

  • I have given my macro code below in a link

    The link is :https://drive.google.com/open?id=16wt7RMgmrhD1LSkNd8L7G8btLQg4Sy2r

    Sub CombineData()
    Dim Sht As Worksheet
    For Each Sht In ActiveWorkbook.Worksheets
    If Sht.Name <> "Master" And Sht.Range("A4").Value <> "" Then
    Sht.Select
    LastRow = Range("A65536").End(xlUp).Row
    Range("A4", Cells(LastRow, "M")).Copy
    Sheets("Master").Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
    Sht.Select
    Range("A4", Cells(LastRow, "M")).ClearContents
    Else
    End If
    Next Sht
    End Sub

    It is not working in the attached exel file.Why?

    Help me.

    Sub CombineData()
    Dim Sht As Worksheet
    For Each Sht In ActiveWorkbook.Worksheets
    If Sht.Name <> "Master" And Sht.Range("A4").Value <> "" Then
    Sht.Select
    LastRow = Range("A65536").End(xlUp).Row
    Range("A4", Cells(LastRow, "M")).Copy
    Sheets("Master").Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
    Sht.Select
    Range("A4", Cells(LastRow, "M")).ClearContents
    Else
    End If
    Next Sht
    End Sub


    ஜெ.இரவிச்சந்திரன்

    Tuesday, November 7, 2017 12:23 PM

Answers

  • Column A is blank in all worksheets, so the part between If ... Then and End If will never be executed. For the same reason, LastRow will always be 1.

    Another point: the data in Table 1 begin two rows lower than those in Table 2...

    Here is a modified macro:

    Sub CombineData()
        Dim Sht As Worksheet
        Dim ShtM As Worksheet
        Dim LastRow As Long
        Application.ScreenUpdating = False
        Set ShtM = Worksheets("Master")
        For Each Sht In ActiveWorkbook.Worksheets
            If Sht.Name <> "Master" And Sht.Range("B3").Value <> "" Then
                LastRow = Sht.Range("B" & Sht.Rows.Count).End(xlUp).Row
                Sht.Range("B5:M" & LastRow).Copy _
                    Destination:=ShtM.Range("A" & ShtM.Rows.Count).End(xlUp).Offset(1)
                Sht.Range("B5:M" & LastRow).ClearContents
            End If
        Next Sht
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Proposed as answer by Terry Xu - MSFT Wednesday, November 8, 2017 2:07 AM
    • Marked as answer by rjagathe Wednesday, November 8, 2017 9:36 AM
    Tuesday, November 7, 2017 6:08 PM

All replies

  • Column A is blank in all worksheets, so the part between If ... Then and End If will never be executed. For the same reason, LastRow will always be 1.

    Another point: the data in Table 1 begin two rows lower than those in Table 2...

    Here is a modified macro:

    Sub CombineData()
        Dim Sht As Worksheet
        Dim ShtM As Worksheet
        Dim LastRow As Long
        Application.ScreenUpdating = False
        Set ShtM = Worksheets("Master")
        For Each Sht In ActiveWorkbook.Worksheets
            If Sht.Name <> "Master" And Sht.Range("B3").Value <> "" Then
                LastRow = Sht.Range("B" & Sht.Rows.Count).End(xlUp).Row
                Sht.Range("B5:M" & LastRow).Copy _
                    Destination:=ShtM.Range("A" & ShtM.Rows.Count).End(xlUp).Offset(1)
                Sht.Range("B5:M" & LastRow).ClearContents
            End If
        Next Sht
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Proposed as answer by Terry Xu - MSFT Wednesday, November 8, 2017 2:07 AM
    • Marked as answer by rjagathe Wednesday, November 8, 2017 9:36 AM
    Tuesday, November 7, 2017 6:08 PM
  • Hi rjagathe,

    How is your issue? Has it been resolved?
    If resolved, and Hans Vogelaar MVP's post was helpful, please mark as answer on Hans Vogelaar MVP's post.

    Regards,

    Ashidacchi

    Wednesday, November 8, 2017 5:15 AM
  • Sir,

    Each time ,before running macro, I need to  insert a new sheet, rename it as "Master" and move it to first position.

    Can you add  code to the macro automating the creation of "Master" sheet.

    Thanks.

    With regards,

    J Ravichandran


    ஜெ.இரவிச்சந்திரன்

    Wednesday, November 8, 2017 9:42 AM
  • Sir,

    The issue was resolved using help from Hans Vogelaar MVP.

    Thanks a lot.


    ஜெ.இரவிச்சந்திரன்

    Wednesday, November 8, 2017 9:44 AM
  • Hi rjagathe,

    You could refer to below code.

        On Error Resume Next
        Set ShtM = Worksheets("Master")
        'check if there is a worksheet named Master
        'if exist, delete original Master sheet
        If Not ShtM Is Nothing Then
        ShtM.Delete
        End If
        Set ShtM = ActiveWorkbook.Sheets.Add(ActiveWorkbook.Sheets(1))
        ShtM.Name = "Master"

    By the way, I would suggest you post a thread so more new eyes could see your issue if you have further issue.

    Best Regards,

    Terry


    MSDN Community Support Please remember to click &amp;quot;Mark as Answer&amp;quot; the responses that resolved your issue, and to click &amp;quot;Unmark as Answer&amp;quot; if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, November 8, 2017 9:52 AM