Row copy from multiple sheets to one sheet

[keiranwyllie]

Good evening,

Can someone help me with the following please?

I have a workbook with a number of worksheets that are filled from a userform.

I'd like to be able to copy the filled cells from several worksheets into one (same workbook).

Sheet1 is filled from columns B:O (from row 9 and down).
Sheet2 is filled using the same as above.
I need the data from sheet1 copied first, then sheet2 copied from the first blank row below sheet1s copied data.

Below is some test code but I can't work out why it's only copying column B of both sheets, and not C through O.

Sub test()
    Application.ScreenUpdating = False
    Dim s1 As Excel.Worksheet
    Dim s2 As Excel.Worksheet
    Dim iLastCellS2 As Excel.Range
    Dim iLastRowS1 As Long
    Set s1 = Sheets("Data")
    Set s2 = Sheets("Data2")
    Set s3 = Sheets("All")
    s3.Range("A1:AI5000").Clear
    ' get last row of J in Sheet1
    iLastRowS1 = s1.Cells(s1.Rows.Count, "B").End(xlUp).Row
    ' get last AVAILABLE cell to past into
    Set iLastCellS3 = s3.Cells(s3.Rows.Count, "A").End(xlUp).Offset(1, 0)
    'copy into sheet2
    s1.Range("B9", s1.Cells(iLastRowS1, "B")).Copy iLastCellS3
    ' get last row of K and sheet2
    iLastRowS2 = s2.Cells(s2.Rows.Count, "B").End(xlUp).Row
    ' get last AVAILABLE cell to past into
    Set iLastCellS3 = s3.Cells(s3.Rows.Count, "A").End(xlUp).Offset(1, 0)
    'copy into sheet2
    s2.Range("B9", s2.Cells(iLastRowS2, "B")).Copy iLastCellS3
End Sub

If anyone can shed some light, that'd be awesome.

 

[vcoolio]

Hello Kieranwyllie,

Just so we fully understand:-

- You have three sheets, the third being a "Master" sheet.
- You need the complete data set from sheets 1 and 2 transferred over to the "Master" sheet.
- The data set extends from Column B to Column O.
- The number of rows are variable.
- Is the data from sheets 1 and 2 to be cleared once the transfer is completed?

Cheerio,
vcoolio.

 

[keiranwyllie]

Hi vccolio, thanks for the speedy reply.

To answer your questions:
- yes
- yes
- yes
- yes (rows grow as data entries are made via the userforms)
- no (the data remains live in the mains sheets because it can be updated)

If I were able to attach an example I would but I can add attachments.

 

[keiranwyllie]

Well I had some luck going about it a different way and this achieves what I want.

Sub ConsolidateData()
     
    Dim wrkMySheet As Worksheet, _
    wrkConsSheet As Worksheet
    Dim lngLastRow As Long, _
    lngOutputRow As Long, _
    lngMyCounter As Long
     
    Application.ScreenUpdating = False
    Sheets("All").Range("A2:AI5000").Clear 'A2 because row 1 contains column headers and clears any previous data on sheet
    Set wrkConsSheet = Sheets("All")
     
    For Each wrkMySheet In ThisWorkbook.Sheets
        If wrkMySheet.Name = "Data" Or wrkMySheet.Name = "Data2" Then
            lngLastRow = wrkMySheet.Range("B:O").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If lngMyCounter = 0 Then
                wrkMySheet.Range("B9:O" & lngLastRow).Copy Destination:=wrkConsSheet.Range("A2")
            Else
                lngOutputRow = wrkConsSheet.Range("B:O").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                wrkMySheet.Range("B9:O" & lngLastRow).Copy Destination:=wrkConsSheet.Range("A" & lngOutputRow)
            End If
            lngMyCounter = lngMyCounter + 1
        End If
    Next wrkMySheet
     
    Application.ScreenUpdating = True
     
End Sub

 

[vcoolio]

Hello Kieran,

I've only just received notification of your first reply (a bit odd it took so long) but if the code in your post#4 works as you would like then can we consider the thread as solved?

Cheerio,
vcoolio.

 

[keiranwyllie]

Sure can ?

 

[vcoolio]

Hello Kieran,

Goodo.

I was thinking something along the lines of:-

Sub CopyData()

Dim lrow As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

Sheet1.UsedRange.Offset(1).ClearContents

For Each ws In Worksheets
     lrow = ws.Range("B" & Rows.Count).End(xlUp).Row
        If ws.Name <> "Sheet1" Then
            ws.Range("B9:O" & lrow).Copy
                Sheet1.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
        End If
Next ws

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

so keep it up your sleeve anyway.

Other than the "Master" sheet, there's no need to refer to the other sheets by name in the code above.
Sheet1 in the code would refer to the "Master" sheet so bear that it mind should you ever use it. Just change it to suit yourself.

I'm really glad that you sorted it out for yourself. Good luck!

Cheerio,
vcoolio.