VBA CopyNoneBlank data from Multiple Cells from One Sheet to another.

markzasz

New Member
Joined
Aug 12, 2015
Messages
29
I have a work book which has two sheets (Input & CSM) from the Input Sheet i would like to scan column (H) starting in cell H6, when the cell is not "Blank" or "VM" i would like to copy the data in cells (H), (J), (R), (V), (AD), (AH), & (AL).

EX:

If H6 was not blank, Copy (H6, J6, R6, V6, AD6, AH6, AL6) The data would then be copied to Sheet(CSM) the first blank row would be A17 and i would
want H6 to A17, J6 to B17, R6 to C17, R6 to D17, V6 to E17, V6 to F17, AD6 to G17, AD6 to H17, AH6 to I17, AH6 to J17, AL6 to k17.

If any one can help with this i would really appreciate it.

Mark Z.

P.S. once i post i will attach a copy of my workbook.
 
Rick,

Sorry.

..H6....J6....R6... V6....AD6..AH6..AL6
AHIN 1000 2000 3000 4000 5000 6000


CSM output would look like this:

...A.....B.....C......D......E......F.....G.......H.....I......J......K
AHIN 1000 2000 2000 3000 3000 4000 4000 5000 5000 6000
Mark
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Rick,
Sorry.
..H6....J6....R6... V6....AD6..AH6..AL6
AHIN 1000 2000 3000 4000 5000 6000
CSM output would look like this:
...A.....B.....C......D......E......F.....G.......H.....I......J......K
AHIN 1000 2000 2000 3000 3000 4000 4000 5000 5000 6000
Mark

Hello Mark, an apology, I did not understand the relationship of columns of origin and destination.
But thanks to Rick's insistence now it's clearer.
I attached a macro without complex structures (or at least that is how I consider it), so that in the subsequent you can make adjustments. Either way, let me know any questions and I will gladly review it.

Code:
Sub CopyData()    Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, lr2 As Long, st As String
    Application.ScreenUpdating = False
    Set sh1 = Sheets("Input")
    Set sh2 = Sheets("CSM")
    If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
    lr = sh1.Range("H" & Rows.Count).End(xlUp).Row
    For i = 6 To lr
        st = UCase(sh1.Cells(i, "H").Value)
        Select Case True
            'List here all the words in uppercase to skip
            Case st = ""
            Case st = "VM"
            Case st = "SHR"
            Case st Like "KP*"
            Case st Like "KT*"
            Case st Like "*ANY WORD*"
            
            Case Else
                lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row + 1
                sh2.Cells(lr2, "A").Value = sh1.Cells(i, "H").Value
                sh2.Cells(lr2, "B").Value = sh1.Cells(i, "J").Value
                sh2.Cells(lr2, "C").Value = sh1.Cells(i, "R").Value
                sh2.Cells(lr2, "D").Value = sh1.Cells(i, "R").Value
                sh2.Cells(lr2, "E").Value = sh1.Cells(i, "V").Value
                sh2.Cells(lr2, "F").Value = sh1.Cells(i, "V").Value
                sh2.Cells(lr2, "G").Value = sh1.Cells(i, "AD").Value
                sh2.Cells(lr2, "H").Value = sh1.Cells(i, "AD").Value
                sh2.Cells(lr2, "I").Value = sh1.Cells(i, "AH").Value
                sh2.Cells(lr2, "J").Value = sh1.Cells(i, "AH").Value
                sh2.Cells(lr2, "K").Value = sh1.Cells(i, "AL").Value
        End Select
    Next
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub
 
Upvote 0
Hello Mark, an apology, I did not understand the relationship of columns of origin and destination.
But thanks to Rick's insistence now it's clearer.
As long as I insisted on Mark giving me a response, I think I should post my code solution for him to consider as well (even though your code works fine)...
Code:
[table="width: 500"]
[tr]
	[td]Sub CopyData()
  Dim sh1 As Worksheet, sh2 As Worksheet, LR As Long, V As Variant
  Application.ScreenUpdating = False
  If Sheets("Input").AutoFilterMode Then sh1.AutoFilterMode = False
  LR = Sheets("Input").Cells(Rows.Count, "H").End(xlUp).Row
  With Sheets("CSM")
    .Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(LR - 5, 11) = Application.Index(Sheets("Input").Cells, Evaluate("ROW(6:" & LR & ")"), Split("[B][COLOR="#0000FF"]8 10 18 18 22 22 30 30 34 34 38[/COLOR][/B]"))
    For Each V In Array([B][COLOR="#FF0000"]"VM", "SHR", "KP*", "KT*", "*Any Word*"[/COLOR][/B])
      .Columns("A").Replace V, "", xlWhole, , False, , False, False
    Next
    On Error Resume Next
    .Columns("A").SpecialCells(xlBlanks).EntireRow.Delete
    On Error GoTo 0
  End With
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]
I used the same list that you (Dante) did so Mark could see how to implement other codes besides VM. For my code, the codes are shown in red above (a comma delimited list of quoted text... letter case does not matter). Also, the numbers in the Split function (shown in blue) are the column numbers on the Input sheet (space delimited) in the order they are to be shown on the CSM sheet.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,568
Messages
6,114,348
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top