VBA CopyNoneBlank data from Multiple Cells from One Sheet to another.
Page 2 of 2 FirstFirst 12
Results 11 to 13 of 13

Thread: VBA CopyNoneBlank data from Multiple Cells from One Sheet to another.
Thanks Thanks: 0 Likes Likes: 0

  1. #11
    New Member
    Join Date
    Aug 2015
    Posts
    27
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA CopyNoneBlank data from Multiple Cells from One Sheet to another.

    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

  2. #12
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,145
    Post Thanks / Like
    Mentioned
    48 Post(s)
    Tagged
    14 Thread(s)

    Default Re: VBA CopyNoneBlank data from Multiple Cells from One Sheet to another.

    Quote Originally Posted by markzasz View Post
    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
    Regards Dante Amor

  3. #13
    MrExcel MVP Rick Rothstein's Avatar
    Join Date
    Apr 2011
    Location
    New Jersey, USA
    Posts
    34,944
    Post Thanks / Like
    Mentioned
    91 Post(s)
    Tagged
    33 Thread(s)

    Default Re: VBA CopyNoneBlank data from Multiple Cells from One Sheet to another.

    Quote Originally Posted by DanteAmor View Post
    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:
    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("8 10 18 18 22 22 30 30 34 34 38")) For Each V In Array("VM", "SHR", "KP*", "KT*", "*Any Word*") .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
    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 by Rick Rothstein; Jul 10th, 2019 at 02:57 PM.
    Rick's "mini" blog... http://www.excelfox.com/forum/f22/
    .
    Want to post a small screen shot? See Part B here.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •