How to copy columns from one sheet to another empty column in new sheet with Macros

Copper Contributor

I am trying to copy 8 columns (C18:J167 - with some merged cells) from Sheet "Assignments" to the next empty columns (starting with B4 in Sheet "Productivity Weekly". Below is my code. However, the problems I'm facing;

  1. It pastes it starting in row B27154
  2. It only pastes the values (not format)
  3. The next time I run the macros, it puts the copied information in the same cells, not the next column. (so first time would be pasting in columns B:K, the next time columns L:S)

 

Sub copycolumns()

Dim lastrow As Long
Dim LastColumn As Long

With Sheets("Productivity Weekly")
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
   LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
End With


Sheets("Assignments").Range("C18:j167").Copy
Sheets("Productivity Weekly").Range("b" & LastColumn + 1 & lastrow + 1).PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False
Application.EnableEvents = True

End Sub

 

4 Replies

@davidtaillefer First of all, tho part of the code where you determine to target cell is not correct.

Range("b" & LastColumn + 1 & LastRow + 1)

Suppose LastColumn = 26 and LastRow =153, the above line of code translates to "B" & 26+1 & 153+1, which results in a cell reference "B27154"

I believe the following piece of code does what you want. It copies values and formats from the first sheet into the next empty column in the second sheet from row 4. If B4 in the second sheet is empty (like the very first time you perform the copy/paste operation to an empty sheet) it will start in in B4.

Sub copycolumns()

Dim TargetSheet As Object
Set TargetSheet = Sheets("Productivity Weekly")

Dim TargetColumn As Integer

TargetColumn = TargetSheet.Range("B4").CurrentRegion.Columns.Count + 2

If TargetSheet.Range("B4") = "" Then
    TargetColumn = 2
End If

Sheets("Assignments").Range("C18:j167").Copy

TargetSheet.Activate
TargetSheet.Cells(4, TargetColumn).Select

Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Application.CutCopyMode = False


End Sub

 Not the most elegant piece of programming, but it works for the task you want to perform.

@Riny_van_Eekelen  Thank you.   Two issues:

When I run this, I get an error. "Run Time Error: '1004': To do this all the Merged Cells must be the same size. "

It is happening in the part of the code:

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

 

Then the second time that I run it, instead of starting to paste in J4 (which would be the next empty column) it pastes in L4.   This means that the 3rd time running it, I get an error "Run-time error '13': Type Mismatch"

This is happening when it is running this part of the code;

If TargetSheet.Range("B4") = "" Then

 

I really appreciate the assistance.

@davidtaillefer Difficult to debug without having your file to test on. The code I provided worked in a workbook in which I tried to replicate the situation you described. With regard the to the first error, get rid of merged cells. They are the source of much "evil". Use "Format cells, Alignment, Horizontal, Center across selection" in stead (credit to @Wyn Hopkins who mentioned this in a recent live session on this site). A few more clicks but it avoids the problems when working with merged cells.

Don't really understand why the same macro would run into different errors for every time it is run. So, can you upload your file (without any confidential information, that is)?

@Riny_van_Eekelen Ok.  I've unmerged those cells.  That worked out perfect.   Then I adjusted the code, removing a +2 in the 5th line.  It works great now.

 

I appreciate all of the assistance.