Copy values from populated cells only to a different sheet, without extra rows after the last populated value

Question

First, with a little searching and some Google-Fu. I have pieced together a working Excel spreadsheet with some VBA. I am by no means a coder, nor is it my profession, however, it is something I have a basic understanding of. That said, I have been banging my head against a wall.

I am pulling data from a website into sheet1 in Excel, copying it to sheet2 while cleaning up the data a bit, copying it a second time to sheet3 to further isolate the information I need. (I know it's an overly complicated process but, by doing it in steps I have a better understanding of what is going on and it helps me learn).

First step, copy mined website data into sheet2:

Sub DataReOrganizer()
   Dim s1 As Worksheet, s2 As Worksheet
   Dim Cook As Long, i As Long, K As Long, v As String
   On Error Resume Next
   Set s1 = Sheets("Sheet1")
   Set s2 = Sheets("Sheet2")
   Cook = s1.Cells(Rows.Count, "A").End(xlUp).Row
   K = 2

   For i = 1 To Cook
      v = s1.Cells(i, "A").Text
      If v = "Contact Information" Then
         K = K + 1
      Else
         ary = Split(v, ": ")
         If ary(0) = "Name" Then s2.Cells(K, 1) = ary(1)
         If ary(0) = "License" Then s2.Cells(K, 2) = ary(1)
         If ary(0) = "License Status" Then s2.Cells(K, 3) = ary(1)
         If ary(0) = "City/State" Then s2.Cells(K, 4) = ary(1)
         If ary(0) = "County" Then s2.Cells(K, 5) = ary(1)
         If ary(0) = "Home Phone" Then s2.Cells(K, 6) = ary(1)
         If ary(0) = "Work Phone" Then s2.Cells(K, 7) = ary(1)
         If ary(0) = "Cell Phone" Then s2.Cells(K, 8) = ary(1)
         If ary(0) = "Email Address" Then s2.Cells(K, 9) = ary(1)
         If ary(0) = "Region" Then s2.Cells(K, 10) = ary(1)
         If ary(0) = "Ever Been Disciplined?" Then s2.Cells(K, 11) = ary(1)
         If ary(0) = "Note" Then s2.Cells(K, 12) = ary(1)
      End If
   Next I
End Sub

Now that the information is no longer one big lumpy mass in column A, I move to step 2: The information is now copied into sheet3 using formulas in each column (A - N) ex:

=IFERROR(SUBSTITUTE(LEFT(Sheet2!$A2,SEARCH(", ",Sheet2!$A2)),",",""),"")

The formulas go to row 1500 in each column, this is done to keep the varying amount of data pulled from the website in sheet3 always organized. I may only have 600 or so rows of data, while the remaining cells, up to 1500, are blank.

This is where I am stuck. I can copy the values (minus the formulas) to sheet4. However, it copies the populated values AND the 900 or so rows of cells that have no calculated values from the formulas. I have searched and found various code to remove empty cells, but they are not working, or I am not able to figure out how to tweak them to my use. No matter what code I use to copy, it always returns 1500 rows, with only 600 or so populated. Am I missing something? I have even tried copying the newly created sheet with only the values, that still returns 1500 lines.

***Edited to add the code I am currently using for testing purposes:

Sub Test_Copy()
    Worksheets("Sheet3").Range("A:N").Copy
    Worksheets("Sheet4").Range("A:N").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

I found another question with some code that copies each cell, one at a time, but that is terribly slow.
Excel macro - paste only non empty cells from one sheet to another

Plus, I get the impression from responses, this is not a good idea, or best practice.

Maldred · Accepted Answer · 2017-10-19T22:11:45.977

1

EDIT AND FIXED

Sub test()

    Dim LastRow As Long

    For y = LastColumnInOneRow To 1 Step -1
        LastRow = Sheets("Sheet3").cells(Sheets("Sheet3").Rows.Count, y).End(xlUp).row
        For x = LastRow To 1 Step -1
            Sheets("Sheet4").cells(x, y).value = Sheets("Sheet3").cells(x, y).value
        Next x
    Next y

End Sub

Private Function LastColumnInOneRow() As Long

    With Sheets("Sheet4")
        LastColumnInOneRow = .cells(1, .Columns.Count).End(xlToLeft).column
    End With

End Function

edited Oct 19 '17 at 22:11

answered Oct 19 '17 at 17:19

Maldred

1,074
4
11
33

Not to sound dense, but exactly how would this be implemented? Because it is a Function, I would call/use it as a formula, ex: =CopyTo(Sheet2!$A2) ??? Right now, my vba code to copy is fairly basic for testing purposes: Sub Test_Copy() Worksheets("Sheet3").Range("A:N").Copy Worksheets("Sheet4").Range("A:N").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub – C.Nug Oct 19 '17 at 18:58
You'd have to have his in your macro some where, `wbSource` would be the workbook your sourcing your data from and `wbDestination` would be the destination it's being copied to – Maldred Oct 19 '17 at 19:05
I am not sure if this is how things should work here, but I responded to your post with a little more in depth answer. Is it possible to assist me some more, thank you? – C.Nug Oct 19 '17 at 20:08
Your edit now works, thank you. However, you will laugh, the copied data is backwards on Sheet4. The last name listed on Sheet3 is now in Row A1 in Sheet4 and proceeds to list everything backwards. It isn't an issue, I just thought you might like to know. – C.Nug Oct 19 '17 at 20:52
Oh ok perfect, keep in mind though that only copies column "A", also yes I forgot to mention that it's backwards, reason being is that it starts from the bottom data and works it's way up. If you have an unknown column count that's a whole separate issue that needs to be dealt with as well, which i don't think is very hard to capture – Maldred Oct 19 '17 at 21:05
Is there a way to have it copy columns A through N? – C.Nug Oct 19 '17 at 21:06
Is it all being pasted into one column? – Maldred Oct 19 '17 at 21:24
No, it will be the same associated columns in the new sheet, A through N – C.Nug Oct 19 '17 at 21:49
Simple change... I've adjusted the answer above and should work as intended – Maldred Oct 19 '17 at 22:04

Copy values from populated cells only to a different sheet, without extra rows after the last populated value

1 Answers1