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

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.

     

     

12 Replies

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

    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

     

     

     

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

      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

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

        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.

Resources