macro to copy content from cells into one cell

[BorisMKD]

Hello guys,
I have a question.
What code do I need to make the data that is in more cells to be shown as data in one cell ?
ex. A5 D5 to be shown as D2(in a new workbook)
1 1 11
And that for every row ?
Thanks, Boris

 

[BorisMKD]

Hello Mikey,

Thanks for helping me.

I tried your code as well, it´s not what I need.

If you want I´ll send the whole code. I need something simililar for the other cells as well.

Option Explicit
Sub Test1()
    Dim Ws1    As Worksheet
    Dim Ws2    As Worksheet
    Dim rngVisible As Range
    Dim fRng   As Range
    Dim X As Long
    Dim R As Long
    'AutoFiltering
    Set Ws1 = Workbooks("Standard_List1.xls").Sheets("SL1-6")
    Set Ws2 = Workbooks("Standard_List1.xls").Sheets("SCS_List")
    Set fRng = Ws1.Cells(6, 1).CurrentRegion
    fRng.AutoFilter
    fRng.AutoFilter Field:=13, Criteria1:="YES"
    On Error Resume Next
    Set rngVisible = fRng.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    'Now starting to copy
    'Copy #1
    Sheets("SCS_List").Range("B2:J1000").ClearContents
    Sheets("Sl1-6").Select
    Range("A3:A3").Select
    Range("A3:A3", ActiveCell.End(xlDown)).Select
    Selection.Copy
    Sheets("SCS_List").Select
    Range("B2:B2").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'Copy #2
    Sheets("Sl1-6").Select
    Range("B3:B3").Select
    Range("B3:B3", ActiveCell.End(xlDown)).Select
    Selection.Copy
    Sheets("SCS_List").Select
    Range("C2:C2").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'Copy #3
    Sheets("Sl1-6").Select
    Range("Q3:Q3").Select
    Range("Q3:Q3", ActiveCell.End(xlDown)).Select
    Selection.Copy
    Sheets("SCS_List").Select
    Range("I2:I2").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'Copy #4
    Sheets("Sl1-6").Select
    Range("P3:P3").Select
    Range("P3:P3", ActiveCell.End(xlDown)).Select
    Selection.Copy
    Sheets("SCS_List").Select
    Range("J2:J2").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Thanks a lot.

p.s. Your code is making something in the same worksheet, what I really don´t need ..

 

[Mike Blackman]

Hi Boris,

How about;

Sub Test1()

    Dim lRow As Long

    Sheets("SCS_List").Range("B2:J1000").ClearContents

    With Sheets("SL1-6")
        With .UsedRange
            .AutoFilter
            .AutoFilter Field:=13, Criteria1:="YES"
        End With
        
        lRow = .Range("A" & Rows.count).End(xlUp).Row
        
        .Range("A3:A" & lRow).SpecialCells(xlCellTypeVisible).Copy
            Sheets("SCS_List").Range("B2").PasteSpecial Paste:=xlValues
        .Range("B3:B" & lRow).SpecialCells(xlCellTypeVisible).Copy
            Sheets("SCS_List").Range("C2").PasteSpecial Paste:=xlValues
        .Range("Q5:Q" & lRow).SpecialCells(xlCellTypeVisible).Copy
            Sheets("SCS_List").Range("I2").PasteSpecial Paste:=xlValues
        .Range("P5:P" & lRow).SpecialCells(xlCellTypeVisible).Copy
            Sheets("SCS_List").Range("J2").PasteSpecial Paste:=xlValues
    End With
    
End Sub

Do we still need to add the concatenation?

 

[BorisMKD]

Hi Mikey,


I think you didn't understand me.
I appreciate your help, but the macro is not working what I need, it makes something else..

Maybe If I post the worksheet here somehow .. & you can see what I mean

Boris