Forum Discussion

Bixente's avatar
Bixente
Copper Contributor
Aug 11, 2021
Solved

Excel Makros code seems right but doesn't work as expected

Hello I'd love to get  some Data from a few sheets, listed on a single sheet. I wrote this code: Sub Tabelle_zusammanfassen() Dim i As Integer Dim Zusammenfassung As Worksheet Set Zusamm...
excel
Macros and VBA
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Aug 14, 2021

    Bixente 

    Please try this...

    Sub CopyDataToMasterSheet()
Dim wsSummary       As Worksheet
Dim ws              As Worksheet
Dim dlr             As Long
Dim RngTotal        As Range
Dim r               As Long

Application.ScreenUpdating = False

Set wsSummary = Worksheets("Summary")

For Each ws In ThisWorkbook.Worksheets
    If Not ws Is wsSummary Then
        Set RngTotal = ws.Columns(1).Find(what:="Total", lookat:=xlPart)
        If Not RngTotal Is Nothing Then
            r = RngTotal.End(xlUp).Row
            If wsSummary.Range("H1").Value = "" Then
                dlr = 1
            Else
                dlr = wsSummary.Cells(Rows.Count, "H").End(xlUp).Row + 1
            End If
            ws.Range("A" & r).Copy wsSummary.Range("H" & dlr)
            ws.Range("J" & r).Copy wsSummary.Range("I" & dlr)
            ws.Range("Q" & RngTotal.Row).Copy wsSummary.Range("J" & dlr)
        End If
    End If
Next ws
Application.ScreenUpdating = True
End Sub

     

    In the attached, you may click the button called "Copy Data" on Summary Sheet to run the code.

     

     

Subodh_Tiwari_sktneer's avatar
Subodh_Tiwari_sktneer
Silver Contributor
Aug 13, 2021

Bixente 

To discard any confusion and considering the fact that your latest sample file may not still represent your actual data, could you please let me know what logic you would apply manually to pick the data to be copied to the Master Sheet? How do you identify the last line to be copied? The line which appears before a cell in column A which contains a sub-string "Total" in it on each Sheet? And if this is correct, there is only one instance of Total in column A?

e.g. on the first data sheet, cell A12 contains text "Total 111111 NAME" so the code will identify this cell and then go above and find row#10 as the last line of your data and pick the data from A12, J12, and Q12 and copy it to Master Sheet. Is this logic correct?

Bixente's avatar
Bixente
Copper Contributor
Aug 13, 2021
Okay so... Manually i would do this:

For Column E in the Summarysheet: Look for the last data in column A before "Total 11111121 NAME"
For Column F in the Summarysheet: Look for the last data in column J
For Column G in the Summarysheet: Look for the last data in column Q

But the issue is that the amount of Rows with Data starting from Row 8 is variating. Otherwise i would just link it with the cell as in your first code.

I am sorry for my bad communication. I try my best to explain the issue. Thank you very much.
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Silver Contributor
    Aug 14, 2021

    You're welcome Bixente! Glad it worked as desired.

     

    Please take a minute to accept the post with the proposed solution as a Best Response to mark your question as Solved.

  • Bixente's avatar
    Bixente
    Copper Contributor
    Aug 14, 2021

    Subodh_Tiwari_sktneer 

    I could adapt the code for my file. What an amazing feeling of satisfaction. I thank you very much for your patience, time and precious help. I wish you all the best.

  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Silver Contributor
    Aug 14, 2021

    Bixente 

    Please try this...

    Sub CopyDataToMasterSheet()
Dim wsSummary       As Worksheet
Dim ws              As Worksheet
Dim dlr             As Long
Dim RngTotal        As Range
Dim r               As Long

Application.ScreenUpdating = False

Set wsSummary = Worksheets("Summary")

For Each ws In ThisWorkbook.Worksheets
    If Not ws Is wsSummary Then
        Set RngTotal = ws.Columns(1).Find(what:="Total", lookat:=xlPart)
        If Not RngTotal Is Nothing Then
            r = RngTotal.End(xlUp).Row
            If wsSummary.Range("H1").Value = "" Then
                dlr = 1
            Else
                dlr = wsSummary.Cells(Rows.Count, "H").End(xlUp).Row + 1
            End If
            ws.Range("A" & r).Copy wsSummary.Range("H" & dlr)
            ws.Range("J" & r).Copy wsSummary.Range("I" & dlr)
            ws.Range("Q" & RngTotal.Row).Copy wsSummary.Range("J" & dlr)
        End If
    End If
Next ws
Application.ScreenUpdating = True
End Sub

     

    In the attached, you may click the button called "Copy Data" on Summary Sheet to run the code.

     

     

Resources