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

markzasz

New Member
Joined
Aug 12, 2015
Messages
27
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
 

Some videos you may like

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,206
Office Version
2007
Platform
Windows
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
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,043
Office Version
2010
Platform
Windows
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:

Watch MrExcel Video

Forum statistics

Threads
1,102,615
Messages
5,487,882
Members
407,613
Latest member
JeffFinnan

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top