VBA data transfer to continue on next empty row (Excel 2013)

[FrancisSIP]

Hello all! So, I have always used Excel but have only gone deeper into formula and VBA writing when my new job required me to do it. Thus, any help is very much appreciated.



I have an Excel workbook that contains a list of items in multiple worksheets. What I'd like it to do is transfer all rows containing values in each worksheets into a new, compiled worksheet, ready to be exported as a CSV. Here is the macro I have cut and pasted for one of those worksheets so far:

Sub SkipBlankRowsSITEWORKS()
    Dim sourcesheet As Worksheet
    Dim finalrow As Long
    Dim i As Long
    Dim j As Long
    
    Set sourcesheet = Worksheets("SITEWORKS") 'change the sheet name accordingly
    
    With sourcesheet
        finalrow = .Cells(.Rows.Count, 3).End(xlUp).Row
    End With
    
    j = 2 'starting row for the active sheet
    For i = 6 To finalrow
        If sourcesheet.Cells(i, 4) <> "" Then 'Target cell to see if empty or not
            ActiveSheet.Cells(j, 1).Value = sourcesheet.Cells(i, 1).Value & " " & sourcesheet.Cells(i, 2).Value
            ActiveSheet.Cells(j, 2).Value = sourcesheet.Cells(i, 2).Value
            ActiveSheet.Cells(j, 3).Value = sourcesheet.Cells(i, 3).Value
            ActiveSheet.Cells(j, 4).Value = sourcesheet.Cells(i, 4).Value
            ActiveSheet.Cells(j, 5).Value = sourcesheet.Cells(i, 5).Value
            ActiveSheet.Cells(j, 6).Value = sourcesheet.Cells(i, 6).Value
            ActiveSheet.Cells(j, 7).Value = sourcesheet.Cells(i, 7).Value
            j = j + 1
        End If
    Next i
End Sub

Essentially, data from sourcesheet "SITEWORKS" is translated into the active sheet. This one works fine. However, I have written the same macro for another worksheet but all it does is write over the data already in the active sheet. So, below is the macro I have written trying to continue the data translation from the source sheet to last empty line on the active sheet.

Sub SkipBlankRowsPRELIMS()
    Dim sourcesheet As Worksheet
    Dim finalrow As Long
    Dim i As Long
    Dim j As Long
    
    Set sourcesheet = Worksheets("PRELIMS") 'Assign worksheet as data source
    
    With ActiveSheet
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    End With

    With sourcesheet
        finalrow = .Cells(.Rows.Count, 3).End(xlUp).Row
    End With
          
    For j = 2 To finalrow
        If ActiveSheet.Cells(j, 1) <> "" Then
        ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
        End If
        Next j 'starting row for the active sheet
    For i = 6 To finalrow
        If sourcesheet.Cells(i, 4) <> "" Then 'Target cell to see if empty or not
            ActiveSheet.Cells(j, 1).Value = sourcesheet.Cells(i, 1).Value & " " & sourcesheet.Cells(i, 2).Value 'Concatenation of Cost Code & Title
            ActiveSheet.Cells(j, 2).Value = sourcesheet.Cells(i, 2).Value
            ActiveSheet.Cells(j, 3).Value = sourcesheet.Cells(i, 3).Value
            ActiveSheet.Cells(j, 4).Value = sourcesheet.Cells(i, 4).Value
            ActiveSheet.Cells(j, 5).Value = sourcesheet.Cells(i, 5).Value
            ActiveSheet.Cells(j, 6).Value = sourcesheet.Cells(i, 6).Value
            ActiveSheet.Cells(j, 7).Value = sourcesheet.Cells(i, 7).Value
            j = j + 1
        End If
    Next i
End Sub

What I have observed when I ran this macro is that it does select the last empty row on the active sheet but translates the data from this sourcesheet ("PRELIMS") onto a specific row, regardless of the data already in the active sheet.

I figured this is the first hurdle to be resolved first before looking into how to get the macro to run through each worksheet as mentioned earlier on.

Thank you in advance everyone!

[Pecoflyer]

Hi and welcome
thanks for wrapping your code with tags, but it is best to use code tags (# button) instead of quote tags. ( Sorry I can't do it for you at the moment)

[NoSparks]

If you're going to do a separate macro for each specific sheet all that needs to change from macro to macro is the specific sheet name and the starting point for j.
So they could all be like your first macro, changing just the sheet name and calculating j instead of hard coding it.

    j = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

You could do everything within a single macro by doing something along the lines of this

Sub CombineSheets()
    Dim sourcesheet As Worksheet
    Dim i As Long, j As Long
    
    j = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    For Each sourcesheet In ThisWorkbook.Sheets
        If sourcesheet.Name <> ActiveSheet.Name Then
            With sourcesheet
                For i = 6 To .Cells(Rows.Count, 3).End(xlUp).Row
                    If .Cells(i, 4) <> "" Then
                        ActiveSheet.Cells(j, 1).Value = .Cells(i, 1).Value & " " & .Cells(i, 2).Value
                        ActiveSheet.Cells(j, 2).Resize(, 6).Value = .Cells(i, 2).Resize(, 6).Value
                        j = j + 1
                    End If
                Next i
            End With
        End If
    Next sourcesheet
End Sub

[FrancisSIP]

Wow! Thanks Sparks! Works like a charm.
Will look more into this to understand how this script works.

[FrancisSIP]

So, the macros were working fine. However, a few hours later, when executing the macros, it runs but no result shows up as per before nor an error message.

I've searched online to find the source of the issue - whether it was a scripting problem or a software setting problem or bug. Hope I could get another helping hand!

The macros are below (I've edited them a bit).:

Sub FullBTExport()
'
' FullBTExport Macro
' Extracts all items with values from each schedule into one takeoff sheet for export.
    
    Range("2:100").Clear 'Erases all existing values from rows 1 to 100.

    Dim sourcesheet As Worksheet
    Dim i As Long, j As Long
    
    j = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    For Each sourcesheet In ThisWorkbook.Sheets
        If sourcesheet.Name <> ActiveSheet.Name Then
            With sourcesheet
                For i = 6 To .Cells(Rows.Count, 3).End(xlUp).Row
                    If .Cells(i, 4) <> "" Then
                        ActiveSheet.Cells(j, 1).Value = .Cells(i, 1).Value
                        ActiveSheet.Cells(j, 2).Resize(, 6).Value = .Cells(i, 2).Resize(, 6).Value
                        j = j + 1
                    End If
                Next i
            End With
        End If
    Next sourcesheet
End Sub

Sub ExportCSV()
'
' ExportCSV Macro
'

Dim wbkExport As Workbook
Dim shtToExport As Worksheet

Set shtToExport = ThisWorkbook.Worksheets("BUILDER TREND ITEMS")     'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = True                       'Possibly overwrite without asking
wbkExport.SaveAs Filename:="BT EXPORT" + " " + Format(Date, "dd-mm-yyyy"), FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=True

End Sub