Copy and paste of multiple columns into one stacked column - Need to be able to select a specific column to which to stack

W

wiscochris

New Member
Joined
Dec 25, 2021
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Hi, I found this awesome vba script here on the forum.

It does exacly what I need where it copies columns BV:BX of "1 - all" and combines them into one column on a separate sheet ("stacked") but it dumps the data into column "A".
I would like to be able to select which column the data gets dumped into so that I can run the script for other data sets and put them in the same "stacked" sheet.

I've tried chaning the column reference "A" to somting else but it does not work :(. I"m not familiar enough with VBA to solve this (I hope) simple issue.

Thanks in advance to anyone who can help me.


VBA Code: 
Sub Copy_Columns()
Application.ScreenUpdating = False
Dim i As Long
Dim lastRow As Long
lastRow = Sheets("1 - All").Cells(Rows.Count, "BV").End(xlUp).Row
Dim Lastrowa As Long
With Sheets("stacked")
   Lastrowa = .Cells(Rows.Count, "a").End(xlUp).Row + 1
   .Cells(Lastrowa, 1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BV").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, "a").End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BW").End(xlUp).Row
   .Cells(Lastrowa, 1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BW").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, "a").End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BX").End(xlUp).Row
   .Cells(Lastrowa, 1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BX").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, "a").End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BY").End(xlUp).Row
   .Cells(Lastrowa, 1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BY").Resize(lastRow).Value
End With
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
[A1] "a" and index 1 are column A revised code
VBA Code: 
Sub Copy_Columns()
Application.ScreenUpdating = False
Dim i As Long
Dim lastRow As Long
lastRow = Sheets("1 - All").Cells(Rows.Count, "BV").End(xlUp).Row
Dim Lastrowa As Long
' Added COL = desired column  "b" or 2
COL = "E"
'replaced "a" and 1 For COL
With Sheets("stacked")
   Lastrowa = .Cells(Rows.Count, COL).End(xlUp).Row + 1
   .Cells(Lastrowa, COL).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BV").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, COL).End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BW").End(xlUp).Row
   .Cells(Lastrowa, COL).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BW").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, COL).End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BX").End(xlUp).Row
   .Cells(Lastrowa, COL).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BX").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, COL).End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BY").End(xlUp).Row
   .Cells(Lastrowa, COL).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BY").Resize(lastRow).Value
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try this shortened version. It will prompt you to enter the desired column.
VBA Code: 
Sub Copy_Columns()
    Application.ScreenUpdating = False
    Dim lastRow As Long, col As String
    col = InputBox("Enter the destination column letter.")
    If col = "" Then Exit Sub
    lastRow = Sheets("1 - All").Cells(Rows.Count, "BV").End(xlUp).Row
    With Sheets("stacked")
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BV").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BW").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BX").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BY").Resize(lastRow).Value
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
bbrnx19 said:
[A1] "a" and index 1 are column A revised code
VBA Code: 
Sub Copy_Columns()
Application.ScreenUpdating = False
Dim i As Long
Dim lastRow As Long
lastRow = Sheets("1 - All").Cells(Rows.Count, "BV").End(xlUp).Row
Dim Lastrowa As Long
' Added COL = desired column  "b" or 2
COL = "E"
'replaced "a" and 1 For COL
With Sheets("stacked")
   Lastrowa = .Cells(Rows.Count, COL).End(xlUp).Row + 1
   .Cells(Lastrowa, COL).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BV").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, COL).End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BW").End(xlUp).Row
   .Cells(Lastrowa, COL).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BW").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, COL).End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BX").End(xlUp).Row
   .Cells(Lastrowa, COL).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BX").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, COL).End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BY").End(xlUp).Row
   .Cells(Lastrowa, COL).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BY").Resize(lastRow).Value
End With
Application.ScreenUpdating = True
End Sub
Click to expand...
Works perfectly. Thank VERY Much!
 
Upvote 0
mumps said:
Try this shortened version. It will prompt you to enter the desired column.
VBA Code: 
Sub Copy_Columns()
    Application.ScreenUpdating = False
    Dim lastRow As Long, col As String
    col = InputBox("Enter the destination column letter.")
    If col = "" Then Exit Sub
    lastRow = Sheets("1 - All").Cells(Rows.Count, "BV").End(xlUp).Row
    With Sheets("stacked")
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BV").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BW").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BX").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BY").Resize(lastRow).Value
    End With
    Application.ScreenUpdating = True
End Sub
Click to expand...
This is great. Thanks for making the code lighter. And I learnd something with the InputBox feature. I ended up changing the " col = InputBox("Enter the destination column letter.")" to col = "B". Great lesson for me. Thanks, again.
 
Upvote 0
OK. As, I mentioned, the script improvements you guys gave me were awesome. I'm running into a problem, though, and would appreciate a little more help. If it's not appropriate to follow up here, please tell me and I can create a new post.

Per the screenshot, BV, BW, BX, BY stack into the new sheet "stacked", just perfectly.
I am trying to add the single column "G" in the screenshot, next to each of those stacked results.

I tried the code below where I repeated "G". Unfortunately, it's not working as intended :(.

VBA Code: 
Sub Copy_Columns_orginal_play()

Dim StartTime As Double
Dim SecondsElapsed As Double

'Remember time when macro starts
  StartTime = Timer

'*****************************
Application.ScreenUpdating = False
    Dim lastRow As Long, col As String
    'col = InputBox("Enter the destination column letter.")
    col = "A"
    If col = "" Then Exit Sub
    lastRow = Sheets("1 - All").Cells(Rows.Count, "G").End(xlUp).Row
    With Sheets("stacked")
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(lastRow).Value
   
    End With
    Application.ScreenUpdating = True
    
    'col = InputBox("Enter the destination column letter.")
    col = "B"
    If col = "" Then Exit Sub
    lastRow = Sheets("1 - All").Cells(Rows.Count, "BV").End(xlUp).Row
    With Sheets("stacked")
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BV").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BW").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BX").Resize(lastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BY").Resize(lastRow).Value
    End With
    Application.ScreenUpdating = True
'*****************************

'Determine how many seconds code took to run
  SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
  'MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub

Thanks in advance for any additonal help.
 

Attachments

  • stacked-title-problem.png
    stacked-title-problem.png
    197.8 KB · Views: 17
Upvote 0
bbrnx19 said:
Please explain.

what dose it do against what you want it do - post pic of stacked sheet mark up errors
Click to expand...
Oh wow. I take it back. it is working exactly as it should. I had some extra rows of data from another test and it was not looking like things were aligning. Thanks for following up with me.
 
Upvote 0
I do have a followup. I'd appreciate help if you are willing.

Please notice how I added a section that should pull some additional columns of data (see the DR through DZ) section.

1) In the screenshot of the "stacked" sheet you can see the result that should be pulling in (column D which I manually copied and pasted) vs what the script is pulling in in column C. The "1 - All" sheet is hilighting in red where that data is being pulled from. For some reason it's starting to uull from row 30 when it should start pulling from row 2.
Could you possibly help me understand what went wrong there/How I can fix?
stacked.png
1-all.png

2) Please see column "B" of the "stacked" sheet. For each section (i.e. BV through BY, and DR through DZ), I'd like to add a row lable that I choose. As in the example in Purple in Column B, I would lable BV through BY as "Local Pack" and DR through DZ as "Organic". I found some code that suggest that I could use Range and Value but I can seem to figure out how to integrate that with this script to work as needed. Could you possibly offer guidance on that too?

Thanks (again) very much.

VBA Code: 
Sub Copy_Columns_orginal_play()

Dim StartTime As Double
Dim SecondsElapsed As Double
  

'Remember time when macro starts
  StartTime = Timer

'*****************************
Application.ScreenUpdating = False
    Dim LastRow As Long, col As String
    'col = InputBox("Enter the destination column letter.")
    col = "A"
    If col = "" Then Exit Sub
    LastRow = Sheets("1 - All").Cells(Rows.Count, "G").End(xlUp).Row
    With Sheets("stacked")
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
    End With
    Application.ScreenUpdating = True
    
    'col = InputBox("Enter the destination column letter.")
    col = "C"
    If col = "" Then Exit Sub
    LastRow = Sheets("1 - All").Cells(Rows.Count, "BV").End(xlUp).Row
    With Sheets("stacked")
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BV").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BW").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BX").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BY").Resize(LastRow).Value

    End With
    Application.ScreenUpdating = True
    
    'col = InputBox("Enter the destination column letter.")
    col = "C"
    If col = "" Then Exit Sub
    LastRow = Sheets("1 - All").Cells(Rows.Count, "DR").End(xlUp).Row
    With Sheets("stacked")
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DR").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DS").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DT").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DU").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DV").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DW").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DX").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DY").Resize(LastRow).Value
        .Cells(.Rows.Count, col).End(xlUp).Offset(1).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DZ").Resize(LastRow).Value
    End With
    Application.ScreenUpdating = True
    
    
'Dim LastRow As Long
'Dim RowNum As Long

Sheets("stacked").Select

'Find the last row in column A
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

'Loop through rows to find the empty cells

Range("A" & "2" & ": A" & LastRow).Select

'Replace the string in column A
Selection.Replace What:=" - Google Search", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
'*****************************

'Determine how many seconds code took to run
  SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
  'MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub
 
Upvote 0
It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheets. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary). Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Stack without VStack
Replies
5
Views
291
Eric W
Eric W
C
  • Question
Copy and paste data through multiple workbooks
Replies
2
Views
199
CDaviess
C
A
  • Solved
VBA copy range from multiple sheets into one, adding the sheet name
2
Replies
12
Views
797
AriannaVV
A
V
  • Solved
Make 1 list of names out of multiple using VBA
2
Replies
10
Views
858
VikingLink
V
S
  • Question
VBA Code - Create Log sheet (Errorlog) in case VBA Macro condition is not met
Replies
1
Views
132
Tupe77
T

Forum statistics

Threads
1,214,864
Messages
6,121,986
Members
449,058
Latest member
oculus

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top