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

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 04-16-2019, 11:38 PM
FrancisSIP FrancisSIP is offline VBA data transfer to continue on next empty row (Excel 2013) Windows 8 VBA data transfer to continue on next empty row (Excel 2013) Office 2013
Novice
VBA data transfer to continue on next empty row (Excel 2013)
 
Join Date: Apr 2019
Posts: 3
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
  #2  
Old 04-17-2019, 01:15 AM
Pecoflyer's Avatar
Pecoflyer Pecoflyer is offline VBA data transfer to continue on next empty row (Excel 2013) Windows 7 64bit VBA data transfer to continue on next empty row (Excel 2013) Office 2010 64bit
Moderator
 
Join Date: Nov 2011
Location: Brussels Belgium
Posts: 2,385
Pecoflyer is a glorious beacon of lightPecoflyer is a glorious beacon of lightPecoflyer is a glorious beacon of lightPecoflyer is a glorious beacon of lightPecoflyer is a glorious beacon of lightPecoflyer is a glorious beacon of light
Default

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)
__________________
Problem solved ? Let others know by clicking " Thread Tools" then " Mark thread as solved".( This can be undone if need be)
Want to thank for the help received ? Click the scales symbol in the upper right corner of a post from the person you want to thank.
Reply With Quote
  #3  
Old 04-18-2019, 06:14 AM
NoSparks NoSparks is offline VBA data transfer to continue on next empty row (Excel 2013) Windows 7 64bit VBA data transfer to continue on next empty row (Excel 2013) Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 706
NoSparks will become famous soon enoughNoSparks will become famous soon enough
Default

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.
Code:
    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
Code:
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
Reply With Quote
  #4  
Old 05-13-2019, 06:35 PM
FrancisSIP FrancisSIP is offline VBA data transfer to continue on next empty row (Excel 2013) Windows 8 VBA data transfer to continue on next empty row (Excel 2013) Office 2013
Novice
VBA data transfer to continue on next empty row (Excel 2013)
 
Join Date: Apr 2019
Posts: 3
FrancisSIP is on a distinguished road
Default

Wow! Thanks Sparks! Works like a charm.
Will look more into this to understand how this script works.
Reply With Quote
  #5  
Old 05-13-2019, 10:08 PM
FrancisSIP FrancisSIP is offline VBA data transfer to continue on next empty row (Excel 2013) Windows 8 VBA data transfer to continue on next empty row (Excel 2013) Office 2013
Novice
VBA data transfer to continue on next empty row (Excel 2013)
 
Join Date: Apr 2019
Posts: 3
FrancisSIP is on a distinguished road
Unhappy Macros were working but now aren't

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

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

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Transfer data from list with multiple headings from word to excel psohms Word 1 06-11-2015 04:39 PM
VBA data transfer to continue on next empty row (Excel 2013) Data Transfer From Excel spc94 Word VBA 1 06-03-2015 09:56 PM
Transfer Data between Excel and Word s_samira_21 Excel 0 01-19-2015 05:21 AM
Data transfer from Word tables to Excel shoro Word 4 10-01-2013 05:08 AM
VBA data transfer to continue on next empty row (Excel 2013) Is it possilble to transfer data from Excel to Publisher? markhuges Publisher 8 10-23-2011 05:55 AM


All times are GMT -7. The time now is 06:03 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2019 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft