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

[markzasz]

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.

 

[markzasz]

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

 

[DanteAmor]

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.

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

 

[Rick Rothstein]

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

[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.