We help IT Professionals succeed at work.

How do I copy only filled cells with a macro?

eureka15
eureka15 asked
on
440 Views
Last Modified: 2012-05-11
I need to copy cells that have been filled from one sheet to other sheet.

The cells to be copied on sheet1 are B7:21 & E7:11 & H7:16. They need to be paste on sheet2 all in one column A1 with NO blank spaces. (see file)

Here is the hard part:
Sheet1 columns will be B E H K N Q T W. These columns will change on how many cells are filled with serial numbers, I still need to copy and all of them on sheet2 in column A with no blank spaces.

I have added a file to help explain.
Jimi  
Labs-Seattle-Equip-Scan-V1.1-xxx.xlsx
Comment
Watch Question

Most Valuable Expert 2012
Top Expert 2012

Commented:
Are columns concatenated together, or are they listed in column A, sequentially?

Please explain what the output in column A looks like for Sheet 2, the first couple rows.

Dave
Most Valuable Expert 2012
Top Expert 2012

Commented:
I see your suggested output in Sheet 2.

Here's your code:

 
Sub copyFilledCells()
Dim colsToCopy() As String

    colsToCopy = Split("B,E,H,K,N,Q,T,W", ",") 'get columns to copy into an array
    
    Sheet1.Activate 'start on the first sheet, where the data is
    
    Sheet2.Cells.ClearContents 'clear output sheet
    
    For i = 0 To UBound(colsToCopy)
        Call copyColumn(colsToCopy(i), Sheet1, Sheet2)
    Next i
    
    MsgBox "Done!"
    Sheet2.Activate
End Sub
Sub copyColumn(colLetter As String, shIn As Worksheet, shOut As Worksheet)
Dim myCell As Range

    If Range(colLetter & Rows.Count).End(xlUp).Row < 7 Then Exit Sub 'no data here
    
    For Each myCell In shIn.Range(colLetter & "7", Range(colLetter & Rows.Count).End(xlUp)) 'row 7 to to the last row with data, with column requested
        shOut.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = myCell.Value 'put value in row to the next available cell in column A of output sheet
    Next myCell
    
End Sub

Open in new window


see attached,

Dave
Labs-Seattle-Equip-Scan-V1.1-xxx.xlsm
Most Valuable Expert 2012
Top Expert 2012

Commented:
Ah - one final touch - to test if A1 has data...  a slight mod adding if statment in the copyColumn() routine.

just run the macro:   copyFilledCells()

here's the final code - note Sheet1 and Sheet2 are objects - you can change their names, replacing those with Sheets("Sheet1") or whatever, and the app will work just fine.
Sub copyFilledCells()
Dim colsToCopy() As String

    colsToCopy = Split("B,E,H,K,N,Q,T,W", ",") 'get columns to copy into an array
    
    Sheet1.Activate 'start on the first sheet, where the data is
    
    Sheet2.Cells.ClearContents 'clear output sheet
    
    For i = 0 To UBound(colsToCopy)
        Call copyColumn(colsToCopy(i), Sheet1, Sheet2)
    Next i
    
    MsgBox "Done!"
    Sheet2.Activate
End Sub
Sub copyColumn(colLetter As String, shIn As Worksheet, shOut As Worksheet)
Dim myCell As Range

    If Range(colLetter & Rows.Count).End(xlUp).Row < 7 Then Exit Sub 'no data here
    
    For Each myCell In shIn.Range(colLetter & "7", Range(colLetter & Rows.Count).End(xlUp)) 'row 7 to to the last row with data, with column requested
        If shOut.Range("A1").Value = "" Then
            shOut.Range("A1").Value = myCell.Value
        Else
            shOut.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = myCell.Value 'put value in row to the next available cell in column A of output sheet
        End If
    Next myCell
    
End Sub

Open in new window

See attached update,

Enjoy!

Dave
Labs-Seattle-Equip-Scan-V1.1-xxx.xlsm
Saqib HusainEngineer
CERTIFIED EXPERT

Commented:
Here is mine
Sub collatecols()
For i = 2 To 24 Step 3
If Sheet1.Cells(7, i) <> "" Then
Sheet1.Range(Sheet1.Cells(7, i), Sheet1.Cells(Sheet1.Cells(Rows.Count, i).End(xlUp).Row, i)).Copy Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next i
End Sub

Open in new window

Most Valuable Expert 2012
Top Expert 2012

Commented:
Clever - I wrote mine anticipating future use, if the columns to copy were to change, lol....

@ssagibh - You might want to ensure your code puts data in Range("A1") of the output sheet, as well :)

Cheers,

Dave
Most Valuable Expert 2012
Top Expert 2012
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
Saqib HusainEngineer
CERTIFIED EXPERT

Commented:
How about

if sheet2.range("A1")="" then sheet2.range("A1").entirerow.delete

before the end sub
Saqib HusainEngineer
CERTIFIED EXPERT

Commented:
To improve readability you can use
Sub collatecols()
For i = 2 To 24 Step 3
    Set fr = Sheet1.Cells(7, i)
    If fr <> "" Then
        Set lr = Sheet1.Cells(Sheet1.Cells(Rows.Count, i).End(xlUp).Row, i)
        Set tr = Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Sheet1.Range(fr, lr).Copy tr
    End If
Next i
If Sheet2.Range("A1") = "" Then Sheet2.Range("A1").EntireRow.Delete
End Sub

Open in new window

Author

Commented:
WOW! I went to dinner and came back to all this great info!
Thanks guys

Jimi
Most Valuable Expert 2012
Top Expert 2012

Commented:
Pleasure is mine/ours.

PS - if your columns to copy change in future, just change this code to represent that:

colsToCopy = Split("B,E,H,K,N,Q,T,W", ",") 'get columns to copy into an array


Cheers,

Dave

Author

Commented:
Thanks Dave
Great fore site Dave...this file will go to 18 offices AND there will be future add-on columns you BET!

Author

Commented:
ssaqibh:
It is really cool how simple simple and small your code was...WOW!
I went with Dave's due to it could be easily changed in the future.

Thanks :D  
Saqib HusainEngineer
CERTIFIED EXPERT

Commented:
I am fine with the acceptance. But you can extend mine too by increasing the 24 on line 2. In fact you can give it a large number to start with and the program will only copy if the column contains data. This program will only fail if the spacing of the copied columns is not regular. At the moment the columns are on a spacing of three. You can easily change the spacing on the same line.

Author

Commented:
ssaqibh:
Oh OK that is good to know, Thanks or the info :D
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.