none
Syntax to select multiple columns/particular column with its contents in Excel VBA RRS feed

  • Question

  • Hi,

    I have a worksheet that i would like to select a particular column and copy the contents to another worksheet. These are the columns that i would like to copy. This will start from row4, Columns B4:E4, H4:AP4, AR4:AS4, AU4, AW4. use the B columns as reference checking the last not empty rows.

    Then trying to copy the contents of the column my problem it create an empty column for the column that are not included in the selection. Also when copying the contents i would like to merge to concatenenate the column E3 and D4.

    I would like to adjust those empty column. May I ask your help guys on how to do this in VBA Macro.

    Here is the vba code. the result it gives me an empty column.

           With ThisWorkbook
            With .Sheets("RNP SDS")
                lastrow1 = .Cells(.Rows.Count, "B").End(xlUp).Row
                Set my_range = .Range("B4:C4,D4:E4,H4:AP4,AR4:AS4,AU4,AW4")
            End With
      
      
            Set ws = .Worksheets("Test")
            lastrow2 = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
            For Each my_area In my_range.Areas
      
                my_area.Resize(lastrow1 - 3).Copy ws.Cells(lastrow2 + 1, my_area.Cells(1, 1).Column)
            Next my_area
        End With






    • Edited by Lenoj Monday, July 28, 2014 2:25 AM
    Monday, July 28, 2014 1:48 AM

Answers

  • Add a declaration

        Dim c As Long

    and change the For ... Next loop to

            c = 2 ' start column
            For Each my_area In my_range.Areas
                my_area.Resize(lastrow1 - 3).Copy ws.Cells(lastrow2 + 1, c)
                c = c + my_area.Columns.Count ' increase column
            Next my_area


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Lenoj Thursday, July 31, 2014 12:31 AM
    Monday, July 28, 2014 6:12 AM
  • You have to copy and to paste special on two separate lines:

            my_area.Resize(lastrow1 - 3).Copy
            ws.Cells(lastrow2 + 1, c).PasteSpecial xlPasteValues



    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Lenoj Thursday, July 31, 2014 12:31 AM
    Monday, July 28, 2014 12:41 PM
  • Does this do what you want?

        With ThisWorkbook
            With .Sheets("ABC SDS")
                lastrow1 = .Cells(.Rows.Count, "B").End(xlUp).Row
                Set my_range = .Range("B4:C4,H4:AT4,AV4:AY4,BA4:BD4,BF4:BI4,BL4:BS4,E4")
            End With
       
            Set ws = .Worksheets("Test")
            If ws.Range("B400").Value <> "" Then
                MsgBox "All rows for ABC have been used!", vbExclamation
                Exit Sub
            End If
            lastrow2 = Application.Max(ws.Range("B400").End(xlUp).Row, 200)
            If lastrow2 + lastrow1 - 3 > 400 Then
                MsgBox "Not enough free rows!", vbExclamation
                Exit Sub
            End If
            c = 2 ' start column
            For Each my_area In my_range.Areas
                my_area.Resize(lastrow1 - 3).Copy
                ws.Cells(lastrow2 + 1, c).PasteSpecial xlPasteValues
                c = c + my_area.Columns.Count ' increase column
            Next my_area
            For r = lastrow2 + 1 To lastrow2 + lastrow1 - 4
                ws.Cells(r, 3) = ws.Cells(r, 2) & ws.Cells(r, 3)
            Next r
            ws.Cells(lastrow2 + 1, 2).Delete Shift:=xlShiftToLeft
        End With


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Lenoj Wednesday, August 6, 2014 12:34 AM
    Tuesday, August 5, 2014 5:27 PM

All replies

  • Add a declaration

        Dim c As Long

    and change the For ... Next loop to

            c = 2 ' start column
            For Each my_area In my_range.Areas
                my_area.Resize(lastrow1 - 3).Copy ws.Cells(lastrow2 + 1, c)
                c = c + my_area.Columns.Count ' increase column
            Next my_area


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Lenoj Thursday, July 31, 2014 12:31 AM
    Monday, July 28, 2014 6:12 AM
  • Thank you very very much. this is what i'm looking.Great.  I would like to add to copy only the values without the formula vice versa. I'm trying to add "PasteSpecial xlPasteValues"

    Got an error. it display #VALUE! in the results.

    my_area.Resize(lastrow1 - 3).Copy ws.Cells(lastrow2 + 1, c).PasteSpecial xlPasteValues

     

    • Edited by Lenoj Monday, July 28, 2014 9:57 AM
    • Marked as answer by Lenoj Thursday, July 31, 2014 12:31 AM
    • Unmarked as answer by Lenoj Thursday, July 31, 2014 12:31 AM
    Monday, July 28, 2014 9:39 AM
  • You have to copy and to paste special on two separate lines:

            my_area.Resize(lastrow1 - 3).Copy
            ws.Cells(lastrow2 + 1, c).PasteSpecial xlPasteValues



    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Lenoj Thursday, July 31, 2014 12:31 AM
    Monday, July 28, 2014 12:41 PM
  • Thank you very much Hans, its already working. I have a last query. what if i would like to add records to row 201?  because the worksheet use by different suppliers. The first 200 rows will be using by HYZ supplier while the ABC will start from 201 and the last supplier XCP will start in row 401.

    Test Worksheet

    Rows

    1-200 BYZ

    201-399 ABC

    401-600- XCP

    I tried this approach but i got an error.

    lastrow2 = ws.Range("B201" & ws.Rows.Count).End(xlUp).Row

        With ThisWorkbook
            With .Sheets("ABC SDS")
                lastrow1 = .Cells(.Rows.Count, "B").End(xlUp).Row
                Set my_range = .Range("B4:C4,D4,H4:AT4,AV4:AY4,BC4,BF4")
            End With
       
            Set ws = .Worksheets("Test")
            lastrow2 = ws.Range("B201" & ws.Rows.Count).End(xlUp).Row
            c = 2 ' start column
            For Each my_area In my_range.Areas
                my_area.Resize(lastrow1 - 3).Copy
                ws.Cells(lastrow2 + 1, c).PasteSpecial xlPasteValues
                c = c + my_area.Columns.Count ' increase column
            Next my_area
        End With


    • Edited by Lenoj Wednesday, July 30, 2014 8:06 AM
    Wednesday, July 30, 2014 12:44 AM
  • "B201" & ws.Rows.Count = "B2011048576". That won't work.

    You could use

        With ThisWorkbook
            With .Sheets("ABC SDS")
                lastrow1 = .Cells(.Rows.Count, "B").End(xlUp).Row
                Set my_range = .Range("B201:C201,D201,H201:AT201,AV201:AY201,BC201,BF201")
            End With
       
            Set ws = .Worksheets("Test")
            If ws.Range("B400").Value <> "" Then
                MsgBox "All rows for ABC have been used!", vbExclamation
                Exit Sub
            End If
            lastrow2 = ws.Range("B400").End(xlUp).Row
            If lastrow2 + lastrow1 - 3 > 400 Then
                MsgBox "Not enough free rows!", vbExclamation
                Exit Sub
            End If
            c = 2 ' start column
            For Each my_area In my_range.Areas
                my_area.Resize(lastrow1 - 3).Copy
                ws.Cells(lastrow2 + 1, c).PasteSpecial xlPasteValues
                c = c + my_area.Columns.Count ' increase column
            Next my_area
        End With


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, July 30, 2014 6:26 AM
  • Hi Hans. Thank you very much for the help and your promp reply. I tried the new codes but still the second supplier copy the records in the last empty cell of the first supplier. Attached an screen shot on the result when copying the records. the color graysupplier  will start copying records from row 2 up to 200, then the color blue supplier will start copying from 201 up to 399 then the  yellow color will start from 401.  Basically, i will create codes for 3 different supplier to copy and paste the records to worksheet test.  thank you.


    • Edited by Lenoj Wednesday, July 30, 2014 9:32 AM
    Wednesday, July 30, 2014 8:20 AM
  • Hi Hans,

    I got already the solution and it's already working. Just added this code.

    If lastrow2 < 200 Then lastrow2 = 200

    Btw, Thank you very much.

       With ThisWorkbook
            With .Sheets("ABC SDS")
                lastrow1 = .Cells(.Rows.Count, "B").End(xlUp).Row
                Set my_range = .Range("B4:C4,E4,H4:AT4,AV4:AY4,BA4:BD4,BF4:BI4,BL4:BS4")
            End With
            
            Set ws = .Worksheets("Test")
            lastrow2 = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
            If lastrow2 < 200 Then lastrow2 = 200
            c = 2
            For Each my_area In my_range.Areas
                my_area.Resize(lastrow1 - 3).Copy
                ws.Cells(lastrow2 + 1, c).PasteSpecial xlPasteValues
                c = c + my_area.Columns.Count
            Next my_area
        End With

    Wednesday, July 30, 2014 9:53 AM
  • Hi Hans,

    Just want to add another queries if this is feasible. I wanted to concatenate the column of C4 and D4 column into one column and also I would like to insert or copy or place the E4 column after the BS4 column using the above vba codes. thank you. 


    • Edited by Lenoj Tuesday, August 5, 2014 1:36 AM
    Tuesday, August 5, 2014 1:36 AM
  • Where do you want to place the concatenated value of C4 and D4?

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Tuesday, August 5, 2014 5:40 AM
  • Thank you for the reply. I would like to place the concatenated value after the B4 or in between B4 and E4.

    Tuesday, August 5, 2014 7:31 AM
  • Does this do what you want?

        With ThisWorkbook
            With .Sheets("ABC SDS")
                lastrow1 = .Cells(.Rows.Count, "B").End(xlUp).Row
                Set my_range = .Range("B4:C4,H4:AT4,AV4:AY4,BA4:BD4,BF4:BI4,BL4:BS4,E4")
            End With
       
            Set ws = .Worksheets("Test")
            If ws.Range("B400").Value <> "" Then
                MsgBox "All rows for ABC have been used!", vbExclamation
                Exit Sub
            End If
            lastrow2 = Application.Max(ws.Range("B400").End(xlUp).Row, 200)
            If lastrow2 + lastrow1 - 3 > 400 Then
                MsgBox "Not enough free rows!", vbExclamation
                Exit Sub
            End If
            c = 2 ' start column
            For Each my_area In my_range.Areas
                my_area.Resize(lastrow1 - 3).Copy
                ws.Cells(lastrow2 + 1, c).PasteSpecial xlPasteValues
                c = c + my_area.Columns.Count ' increase column
            Next my_area
            For r = lastrow2 + 1 To lastrow2 + lastrow1 - 4
                ws.Cells(r, 3) = ws.Cells(r, 2) & ws.Cells(r, 3)
            Next r
            ws.Cells(lastrow2 + 1, 2).Delete Shift:=xlShiftToLeft
        End With


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Lenoj Wednesday, August 6, 2014 12:34 AM
    Tuesday, August 5, 2014 5:27 PM
  • Thank you very much Hans. I'll try this codes when i came back from vacation.

    Wednesday, August 6, 2014 12:35 AM