Help with setting up a VBA

[Newbie73]

Hello, I was wondering if I could aumtomate the following in Excel, perhaps with the help of VBA (my first one with VBA)

Example VBA.xlsx

The example spreadsheet has 3 sheets. The raw data has the bulk of the data, here I would like for K2 to be copied down until the end of the table, It's a date so I need the same data to be copied down. Same with L2 (it usually just a word if it matters).

Then I would like everything (apart from the header, so row 1) to be copied to the sheet Data to the exact same columns order (which I named from 1 to 14, it's important that 2 goes to 2, 14 to 14 etc), the Data sheet has a formula on A2 through all the sheet and this is necessary but it's already there, no need to do anything.

I've done the Data wanted result sheet just to show how it's supposed to look. Despite some columns between 2 and 13 being blanked all needs to be copied over as sometimes this columns will have values

Is this doable and is VBA the way? This would repeat itself for many sheets, so all the copied information would be put right at the end of the previous information on the Data sheet (so that there's no blank rows)

Do let me know if I explained this correctly or if you need any more information or if this is even doable! Thank you

 

[mumps]

I would like for K2 to be copied down until the end of the table, It's a date so I need the same data to be copied down. Same with L2 (it usually just a word if it matters).

In your sample sheet, L2 is a date and K2 is text. Is this correct? Will columns K and L have data only in row 2 and nothing in the rows below? Will the other columns have data below row 2?

it's important that 2 goes to 2, 14 to 14

Does this mean that you don't want to copy column A?

 

[Alex Blakenburg]

Try this in a standard module in VBA.
You will need to modify the If statement to exclude any sheets you don't want appended to Data.
Alternatively if you have a standard naming convention for the sheets that you do want appended we could use that in the if statement.

Sub CollateData()

    Dim wsData As Worksheet, wsSrc As Worksheet
    Dim dataLastRow As Long, srcLastRow As Long
    
    Application.ScreenUpdating = False
    Set wsData = Worksheets("Data")
    
    For Each wsSrc In ActiveWorkbook.Worksheets
        With wsSrc
            ' Exclude Sheets from consolidation
            If .Name <> "Data" _
                And .Name <> "Data Wanted Result" Then
                ' Fill Down Data
                srcLastRow = .Range("A" & Rows.Count).End(xlUp).Row
                .Range(.Cells(2, "K"), .Cells(srcLastRow, "L")).FillDown
                
                ' Copy Data
                dataLastRow = wsData.Range("B" & Rows.Count).End(xlUp).Row + 1
                .Range(.Cells(2, "A"), .Cells(srcLastRow, "L")).Copy _
                    Destination:=wsData.Range("B" & dataLastRow)
                .Range(.Cells(2, "N"), .Cells(srcLastRow, "N")).Copy _
                    Destination:=wsData.Range("P" & dataLastRow)
            End If
        End With
    Next wsSrc
    
    ' Optional - extend formula in column A
    With wsData
        dataLastRow = .Range("B" & Rows.Count).End(xlUp).Row
        Dim colALastRow As Long
        colALastRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range(.Cells(colALastRow, "A"), .Cells(dataLastRow, "A")).FillDown
    End With

    Application.ScreenUpdating = True
End Sub

 

[Newbie73]

Thank for the replies! Alex that did the trick, sorry if it's a stupid question but in a spreadsheet with more sheets I need to add all the sheets that I don't want to copy to the exclude section in the code correct?

Possibly another silly question, but is there a way to configure that code to run in sheets in the right side of the Data sheet? As in, I could add all the sheets that need copying in that format right to the Data sheet and all other sheets in the left?

For example to try to be more clear in my question on the sheet menu in the bottom:

non related Sheet 1 / non related Sheet 2 / Non related Sheet 3 / Data / Sheet to copy 1 / Sheet to copy 2 / Sheet copy 3

Sorry if it's not doable or if they're stupid question! Just starting my journey in VBA

 

[Alex Blakenburg]

I have logged out for the night, so if @mumps doesn't answer you I can have a look tomorrow.
Excel internally numbers the sheet index no from left to right, so that is pretty easy to do.

 

[Newbie73]

Thank you so much, no rush I can wait! Truly appreciate it and that’s good to know! As I can create all the sheets that need copy to the right of the Data sheet, and when done can run the code to copy it all to Data sheet, leaving all the other sheets untouched to the left of the Data sheet

 

[Newbie73]

Just a quick thought, it could also just apply to sheets with a date as a name. For example 20-10-2020 as this will be the only sheets that the code would run on.

Another question for when you read this again, say that there's 30 sheets, I run the code for those 30 sheets. If I need to update it and add one or two more sheets, the code would on the 32 sheets adding a lot of duplicates.

Is there a way to avoid this? Or am I better off doing manually the ones that I add afterwards?

 

[mumps]

Using a variation of Alex's code, this should work:

Sub CollateData()
    Application.ScreenUpdating = False
    Dim wsData As Worksheet, x As Long
    Dim dataLastRow As Long, srcLastRow As Long
    Set wsData = Worksheets("Data")
    For x = wsData.Index + 1 To Sheets.Count
        With Sheets(x)
            srcLastRow = .Range("A" & Rows.Count).End(xlUp).Row
            .Range(.Cells(2, "K"), .Cells(srcLastRow, "L")).FillDown
            .Range("A2:L" & srcLastRow).Copy wsData.Cells(wsData.Rows.Count, "B").End(xlUp).Offset(1)
            .Range("N2:N" & srcLastRow).Copy wsData.Cells(wsData.Rows.Count, "P").End(xlUp).Offset(1)
        End With
    Next x
    With wsData
        dataLastRow = .Range("B" & Rows.Count).End(xlUp).Row
        Dim colALastRow As Long
        colALastRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range(.Cells(colALastRow, "A"), .Cells(dataLastRow, "A")).FillDown
    End With
    Application.ScreenUpdating = True
End Sub

say that there's 30 sheets, I run the code for those 30 sheets. If I need to update it and add one or two more sheets, the code would on the 32 sheets adding a lot of duplicates.

In order to do this, we would need to keep track of the sheet count by using a helper cell in your Data sheet. What is the last used column in the Data sheet?

 

[Newbie73]

Thanks mumps! It's working great

Sub CollateData()
Application.ScreenUpdating = False
Dim wsData As Worksheet, x As Long
Dim dataLastRow As Long, srcLastRow As Long
Set wsData = Worksheets("Data")
For x = wsData.Index + 1 To Sheets.Count
With Sheets(x)
srcLastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Range(.Cells(2, "K"), .Cells(srcLastRow, "L")).FillDown
.Range("A2:L" & srcLastRow).Copy wsData.Cells(wsData.Rows.Count, "B").End(xlUp).Offset(1)
.Range("P2:Q" & srcLastRow).Copy wsData.Cells(wsData.Rows.Count, "P").End(xlUp).Offset(1)
End With
Next x
With wsData
dataLastRow = .Range("B" & Rows.Count).End(xlUp).Row
Dim colALastRow As Long
colALastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Range(.Cells(colALastRow, "A"), .Cells(dataLastRow, "A")).FillDown
End With
Application.ScreenUpdating = True
End Sub

Changed just the red bit as it wasn't copying column P (and extend it to column Q as I realised that I need it as well)

Regarding the helper cell that should be alright. The last used column in the Data sheet is Q

 

[Alex Blakenburg]

I would normally use a dictionary but since you are new to VBA and have MS365 it thought I would try to keep is simple and give this a try.
You might want to give column R a heading on the data sheet maybe, Source or Sheet Name

Sub CollateData_v02()

    Dim wsData As Worksheet, wsSrc As Worksheet
    Dim dataLastRow As Long, srcLastRow As Long
    Dim srcRowCnt As Long
    Dim ListDoneSheets As Variant
    Dim i As Long
    
    Application.ScreenUpdating = False
    Set wsData = Worksheets("Data")
    With wsData
        dataLastRow = wsData.Range("B" & Rows.Count).End(xlUp).Row
        ListDoneSheets = WorksheetFunction.Unique(wsData.Range("R2:R" & dataLastRow))
    End With
    
    For i = wsData.Index + 1 To Sheets.Count
        Set wsSrc = Sheets(i)
        If IsError(Application.Match(wsSrc.Name, ListDoneSheets, 0)) Then
            With wsSrc
                ' Fill Down Data
                srcLastRow = .Range("A" & Rows.Count).End(xlUp).Row
                srcRowCnt = srcLastRow - 1                                  ' 1 being the row no of the heading row
                .Range(.Cells(2, "K"), .Cells(srcLastRow, "L")).FillDown
                
                ' Copy Data
                dataLastRow = wsData.Range("B" & Rows.Count).End(xlUp).Row + 1
                .Range(.Cells(2, "A"), .Cells(srcLastRow, "L")).Copy _
                    Destination:=wsData.Range("B" & dataLastRow)
                .Range(.Cells(2, "P"), .Cells(srcLastRow, "Q")).Copy _
                    Destination:=wsData.Range("P" & dataLastRow)
                ' Add Source Sheet identifier
                wsData.Range("R" & dataLastRow).Resize(srcRowCnt).Value = .Name
            End With
        End If
    Next x
    
    ' Optional - extend formula in column A
    With wsData
        dataLastRow = .Range("B" & Rows.Count).End(xlUp).Row
        Dim colALastRow As Long
        colALastRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range(.Cells(colALastRow, "A"), .Cells(dataLastRow, "A")).FillDown
    End With

    Application.ScreenUpdating = True
End Sub