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 12, 2021

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
Bixente's avatar
Bixente
Copper Contributor
Aug 13, 2021

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.

Resources