Use VBA to copy a column into the next empty column

[niklas]

Hi everyone,


first post for me. I am trying to write a macro that copies the values in a specific range (the values originates from a pivot table in the background) and then paste as values into a new column on a different sheet. For example - say the source data sits in A1 to A10 on Sheet "Source" then when the macro is run the first time it would copy A1 to A10 and paste as values into a new sheet called "Date" into cell B1. The second time the macro is run it would paste as values into "Date" C1, the third time the macro is run into D1 and so on. I know my vlookups but cannot figure out how to do this


thanks so much Niklas

 

[SirJB7]

Hi, niklas!


First of all welcome to Chandoo's website Excel forums. Thank you for your joining us and glad to have you here.


As a starting point I'd recommend you to read the green sticky topics at this forums main page. There you'll find general guidelines about how this site and community operates (introducing yourself, posting files, netiquette rules, and so on).


Among them you're prompted to perform searches within this site before posting, because maybe your question had been answered yet.


Feel free to play with different keywords so as to be led thru a wide variety of articles and posts, and if you don't find anything that solves your problem or guides you towards a solution, you'll always be welcome back here. Tell us what you've done, consider uploading a sample file as recommended, and somebody surely will read your post and help you.


And about questions in general...


If you haven't performed yet the search herein, try going to the topmost right zone of this page (Custom Search), type the keywords used in Tags field when creating the topic or other proper words and press Search button. You'd retrieve many links from this website, like the following one(s) -if any posted below-, maybe you find useful information and even the solution. If not please advise so as people who read it could get back to you as soon as possible.


And about this question in particular...


Give a look at this file:

https://dl.dropboxusercontent.com/u/60558749/Use%20VBA%20to%20copy%20a%20column%20into%20the%20next%20empty%20column%20%28for%20niklas%20at%20chandoo.org%29.xlsm


It uses 2 dynamic named ranges:

SourceTable: =DESREF(Hoja1!$A$1;;;MIN(10;CONTARA(Hoja1!$A:$A));MIN(1;CONTARA(Hoja1!$1:$1))) -----> in english: =OFFSET(Hoja1!$A$1,,,MIN(10,COUNTA(Hoja1!$A:$A)),MIN(1,COUNTA(Hoja1!$1:$1)))

TargetTable: =DESREF(Hoja2!$A$1;;;CONTARA(Hoja2!$A:$A);CONTARA(Hoja2!$1:$1)+1) -----> in english: =OFFSET(Hoja2!$A$1,,,COUNTA(Hoja2!$A:$A),COUNTA(Hoja2!$1:$1)+1)


If you now that source will be always of 10x1 cells, you could prevent from using MIN functions. Adjust worksheets names properly. There are two versions of the code depending on if you're going to do something else with the data (use version 1) or just copy it (use version 2).

This is the code:

-----

Option Explicit

Sub CopyAtRightmost()
'(*) lines just used for testing purposes, remove them later
' constants
Const ksWSSource = "Hoja1"
Const ksSource = "SourceTable"
Const ksWSTarget = "Hoja2"
Const ksTarget = "TargetTable"
' declarations
Dim rngS As Range, rngT As Range
Static J As Integer '(*)
Dim I As Integer
' start
Set rngS = Worksheets(ksWSSource).Range(ksSource)
Set rngT = Worksheets(ksWSTarget).Range(ksTarget)
J = J + 1 '(*)
Worksheets(3).Cells(1, 1).Value = J '(*)
' process
rngS.Copy rngT.Columns(rngT.Columns.Count)
' end
Set rngT = Nothing
Set rngS = Nothing
Beep
End Sub

Sub CopyAtRightmostShortened()
'(*) lines just used for testing purposes, remove them later
' constants
' declarations
Static J As Integer '(*)
' start
J = J + 1 '(*)
Worksheets(3).Cells(1, 1).Value = J '(*)
' process
Worksheets("Hoja1&#34.Range("SourceTable&#34.Copy _
Worksheets("Hoja2&#34.Range("TargetTable&#34.Columns(Worksheets("Hoja2&#34.Range("TargetTable&#34.Columns.Count)
' end
Beep
End Sub

Sub CopyAtRightmostValues()
'(*) lines just used for testing purposes, remove them later
' constants
Const ksWSSource = "Hoja1"
Const ksSource = "SourceTable"
Const ksWSTarget = "Hoja2"
Const ksTarget = "TargetTable"
' declarations
Dim rngS As Range, rngT As Range
Static J As Integer '(*)
Dim I As Integer
' start
Set rngS = Worksheets(ksWSSource).Range(ksSource)
Set rngT = Worksheets(ksWSTarget).Range(ksTarget)
J = J + 1 '(*)
Worksheets(3).Cells(1, 1).Value = J '(*)
' process
rngS.Copy
Worksheets(ksWSTarget).Select
rngT.Cells(1, rngT.Columns.Count).Select
Selection.PasteSpecial xlPasteValues
Worksheets(ksWSSource).Select
' end
Set rngT = Nothing
Set rngS = Nothing
Beep
End Sub

Sub CopyAtRightmostShortenedValues()
'(*) lines just used for testing purposes, remove them later
' constants
' declarations
Static J As Integer '(*)
' start
J = J + 1 '(*)
Worksheets(3).Cells(1, 1).Value = J '(*)
' process
Worksheets("Hoja1&#34.Range("SourceTable&#34.Copy
With Worksheets("Hoja2&#34
.Select
.Range("TargetTable&#34.Cells(1, .Range("TargetTable&#34.Columns.Count).Select
Selection.PasteSpecial xlPasteValues
End With
Worksheets("Hoja1&#34.Select
' end
Beep
End Sub

-----


Just advise if any issue.


Regards!


EDITED

 

[niklas]

Thanks so much. Works really well. The only question (and I tried to figure it out with no success) was if I wanted to paste as values instead.


Niklas

 

[niklas]

I was able to come up with a not so classy solution but it works


Sub CopyAtRightmostShortened()

'(*) lines just used for testing purposes, remove them later

' constants

' declarations

Static J As Integer '(*)

' start


Sheets("Hoja1").Select

Range("F24:F38").Select

Selection.Copy

Range("H24").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("Hoja2").Select

Range("G19").Select


J = J + 1 '(*)


Worksheets(3).Cells(1, 1).Value = J '(*)

' process

Worksheets("Hoja1").Range("northa").Copy _

Worksheets("Hoja2").Range("TargetTable").Columns(Worksheets("Hoja2").Range("TargetTable").Columns.Count)


' end

Beep

End Sub

 

[SirJB7]

Hi, niklas!


Code fixed and edited at original post, file uploaded so please download it again from same previous link. You'll find 4 versions, 2 for copying (normal and shortened) and 2 for copying values (idem).


Well done! That's a kick-off, keep on going.


Just advise if any issue.


Regards!