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

[Bixente]

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 Zusammenfassung = Worksheets("Zusammenfassung")
For i = 2 To Worksheets.Count

Set BereichZielTab = Worksheets(i).Range("b5")
Set LetzteZeileZusammenfassung = Worksheets(1).Cells(Rows.Count, "A").End(xlUp)
BereichZielTab.Copy Destination:=LetzteZeileZusammenfassung
Next i

End Sub

Instead of listing the Data, it pops up in the A1 cell one by one and when it's over there's nothing left. Any idea what i'm doing wrong?

[#2]

@Bixente 

Try it like this...

Sub Tabelle_zusammanfassen()
Dim i               As Integer
Dim Summary         As Worksheet
Dim RangeTargetTab  As Range
Dim LastLineSummary As Long

Set Summary = Worksheets("Summary")
For i = 2 To Worksheets.Count

Set RangeTargetTab = Worksheets(i).Range("b5")
LastLineSummary = Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
RangeTargetTab.Copy Summary.Range("A" & LastLineSummary)
Next i

End Sub

Or you may try it like this...

Sub Tabelle_zusammanfassen()
Dim Summary         As Worksheet
Dim ws              As Worksheet
Dim RangeTargetTab  As Range
Dim i               As Integer
Dim dlr             As Long

Application.ScreenUpdating = False

Set Summary = Worksheets("Summary")

For Each ws In ThisWorkbook.Worksheets
    If Not ws Is Summary Then
        dlr = Summary.Cells(Rows.Count, "A").End(xlUp).Row + 1
        ws.Range("B5").Copy Summary.Range("A" & dlr)
    End If
Next ws

Application.ScreenUpdating = True
End Sub

[#3]

@Subodh_Tiwari_sktneer Thank you so much. This is working. You're already a hero to me.

I still would have a question: For the next column i don't need the data from the same cell in every sheet but always from the last line of a table. But it isn't always the last line from the sheet. The table always starts at the line 8. Let's say i have a table with 5 lines and i need the data from the last one in column A. Ist this possible somehow?


Best wishes
Bixente

[#4]

@Bixente 

You're welcome! Yes, it seems possible but to discard any confusion, I suggest you to upload a sample file along with some dummy data on data sheets and expected output on Summary Sheet to let me know what exactly you are trying to achieve. Add some comments on the Summary Sheet to describe the logic behind the output if necessary.

[#5]

@Subodh_Tiwari_sktneer Thank you so much for your reply. I hope the file is clear to you. Let's say i'll always need 1 and 12.08.2021. 

[#6]

@Bixente 

Does the following code work for you?

Sub Tabelle_zusammanfassen()
Dim Summary         As Worksheet
Dim ws              As Worksheet
Dim RangeTargetTab  As Range
Dim i               As Integer
Dim dlr             As Long
Dim n               As Variant

Application.ScreenUpdating = False

Set Summary = Worksheets("Summary")

For Each ws In ThisWorkbook.Worksheets
    If Not ws Is Summary Then
        dlr = Summary.Cells(Rows.Count, "E").End(xlUp).Row + 1
        n = Application.Match(1, ws.Columns(1), 0)
        If Not IsError(n) Then
            ws.Range("A" & n).Copy Summary.Range("E" & dlr)
            ws.Range("D" & n).Copy Summary.Range("F" & dlr)
        End If
    End If
Next ws

Application.ScreenUpdating = True
End Sub

[#7]

@Subodh_Tiwari_sktneer First of all, i want to thank you for your time. I really apriciate it a lot.

Of course the code works in the Dummy File. But it doesn't work on my file. I think in spite of the file i sent you, we still missunderstood each other. If i get that right, this code only works if i am looking for "1". But of course the Data can be different.

I took the time to rewrite the file with some Dummy Data as i have it 1:1 (but with less sheets of course). While i was preparing this file, i saw a major mistake: For the column G, i don't need the data from the last row of the table in Q but the very last line. I'm so sorry.  I think you should get it with this file.

Again, thank you very much for your help.

[#8]

@Subodh_Tiwari_sktneer P.S. This second file now has the same amount of rows on every sheet. Of course the original one doesn't. Otherwise the first code you sent me would work again.


Best wihes
Bixente

[#9]

@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?

[#10]

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.

[#11 · Accepted solution]

@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.

[#12]

@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.

[#13]

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.