Macro to Copy Data from Sheet BR1 Shirt Sales to Last Sheet

[howard]

I have data in I1 and J1 on sheet BR1 Shirt Sales to Last Sheet

I need to copy this data and paste these as values one below each other in Cols I and J on sheet Consolidated


I have tried to write code to do this but it is only pasting the data in Col I1 and J1 from sheet BR1 Shirt Sales


It would be appreciated if someone could amend my code

 Sub ExtractDataCols_IandJ()
    Dim lastRow As Long
    Dim targetSheet As Worksheet
    Dim sourceSheet As Worksheet
    Dim targetRow As Long
    Dim sourceRow As Long
   
    ' Set the target sheet to Consolidated
    Set targetSheet = ThisWorkbook.Sheets("Consolidated")
   
    ' Clear the data in column I and J on the target sheet
    targetSheet.Range("I:I,J:J").ClearContents
   
    ' Set the initial target row to 1
    targetRow = 1
   
    ' Loop through each sheet in the workbook
    For Each sourceSheet In ThisWorkbook.Sheets
        ' Check if the sheet name starts with "BR1 Shirt Sales"
        If Left(sourceSheet.Name, 24) = "BR1 Shirt Sales" Then
            ' Copy the data in cells I1 and J1 from the source sheet to the target sheet
            targetSheet.Range("I" & targetRow).Value = sourceSheet.Range("I1").Value
            targetSheet.Range("J" & targetRow).Value = sourceSheet.Range("J1").Value
           
            ' Find the last row in column I of the source sheet
            lastRow = sourceSheet.Cells(Rows.Count, "I").End(xlUp).Row
           
            ' Loop through each row in columns I and J of the source sheet
            For sourceRow = 2 To lastRow
                ' Copy the data in column I and J from the source sheet to the target sheet
                targetSheet.Range("I" & targetRow + sourceRow - 1).Value = sourceSheet.Range("I" & sourceRow).Value
                targetSheet.Range("J" & targetRow + sourceRow - 1).Value = sourceSheet.Range("J" & sourceRow).Value
            Next sourceRow
           
            ' Increment the target row by the number of rows copied from the source sheet
            targetRow = targetRow + lastRow - 1
        End If
    Next sourceSheet
   
    ' Select cell A1 on the target sheet
    targetSheet.Range("A1").Select
End Sub

 

[kevin9999]

I don't quite understand why you're using a loop when you could just copy the entire range in one go. Does this achieve what you're looking for?

Option Explicit
Sub Howard()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("BR1 Shirt Sales")
    Set ws2 = Worksheets("Consolidated")
    
    ws2.Range("I:J").EntireColumn.ClearContents
    ws1.Range("I1:J" & ws1.Cells(Rows.Count, "J").End(xlUp).Row).Copy
    ws2.Range("I1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.Goto ws2.Range("A1")
End Sub

 

[kevin9999]

In case columns I & J are of different lengths on the source sheet:

Option Explicit
Sub Howard_2()
    Dim ws1 As Worksheet, ws2 As Worksheet, LRow As Long
    Set ws1 = Worksheets("BR1 Shirt Sales")
    Set ws2 = Worksheets("Consolidated")
    LRow = ws1.Range("I:J").Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    
    ws2.Range("I:J").EntireColumn.ClearContents
    ws1.Range("I1:J" & LRow).Copy
    ws2.Range("I1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.Goto ws2.Range("A1")
End Sub

 

[howard]

Thanks for the help. The data is only being copied from sheet "BR1 Shirt Sales" I need the data to copy the data in Cols I & J from sheet "BR1 Shirt Sales" to the last sheet and paste in Col I and J on sheet "Consolidated"

Kindly amend code accordingly

 

[kevin9999]

Does the "last sheet" have a name, or is it simply the last sheet in the workbook? Also, do you want it copied to columns I:J in the last sheet? Just so I'm totally clear, you want columns I:J from the BRI Shirt Sales sheet to both the Consolidated sheet AND the last sheet as well?

 

[howard]

I want the data copied from Sheets BR1 Shirt Sales up to the last sheet in the workbook and pasted on sheet Consolidated in ColI an J one below each Other

 

[kevin9999]

So for example, if there's 5 sheets, the first one is called Consolidated, the second one is called BRI Shirt Sales, then the data from BRI Shirt Sales up to and including sheet 5 inclusive is copied to the Consolidated sheet? Is that right?

 

[kevin9999]

Try this Howard:

Option Explicit
Sub Howard_2()
    Application.ScreenUpdating = False
    Dim ws1 As Worksheet, LRowS As Long, LRowD As Long, n As Long, i As Long
    Set ws1 = Worksheets("Consolidated")
    ws1.Range("I:J").EntireColumn.ClearContents
    n = Worksheets("BR1 Shirt Sales").Index
    
    For i = n To Worksheets.Count
        If Worksheets(i).Name <> "Consolidated" Then
            LRowS = Worksheets(i).Range("I:J").Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
            Worksheets(i).Range("I1:J" & LRowS).Copy
            LRowD = ws1.Cells(Rows.Count, "I").End(xlUp).Row
            ws1.Range("I" & LRowD).Offset(1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    Next i
    Application.Goto ws1.Range("A1")
    Application.ScreenUpdating = True
End Sub

 

[howard]

Hi Kevin

Many thanks.Your code works 100%

 

[kevin9999]

Happy to hear Howard, and thanks for the feedback