View Single Post
 
Old 04-16-2019, 11:38 PM
FrancisSIP FrancisSIP is offline Windows 8 Office 2013
Novice
 
Join Date: Apr 2019
Posts: 5
FrancisSIP is on a distinguished road
Post VBA data transfer to continue on next empty row (Excel 2013)

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:

Code:
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.

Code:
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!
Reply With Quote