I am writing a macro that loops through a "source" sheet and for each value in column A, copy a range from template sheet to a destination sheet. After the template range is copied, I need to change a few values in destination sheet based on the source sheet value. Right now I am trying to get the copy working. The copy is failing with error 1004 'The information cannot be pasted because the Copy area and the paste area are not the same size.'
Sub CopyRangeFromOneSheetToAnother()
Dim iLastRow As Long
Dim wb As Workbook
Dim shtSource As Worksheet
Dim shtTemplate As Worksheet
Dim shtDest As Worksheet
Dim sResourceName
Dim rngCalcTemplate As Range
Set wb = ThisWorkbook
Set shtSource = wb.Sheets(1)
Set shtTemplate = wb.Sheets("res_tpl")
Set shtDest = wb.Sheets.Add
'--set range for copying. Hard-coded for now would be nice if it would auto shrink/expand
Set rngCalcTemplate = shtTemplate.Range("A2:M7")
'Find the last row (in column A) with data.
iLastRow = shtSource.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
'--loop through source sheet and copy template range to dest for each
For iSourceSheetRow = 2 To iLastRow
sResourceName = shtSource.Cells(iSourceSheetRow, 1)
rngCalcTemplate.Copy shtDest.Range("A" & Rows.Count).End(xlDown)
Next
End Sub
The problem is with the following line of your code:
rngCalcTemplate.Copy shtDest.Range("A" & Rows.Count).End(xlDown)
If you place your cursor at the very last cell in column A (i.e. at "A" & Rows.Count, possibly A1048576) and then press Ctrl-Down, you are still at the very last cell in column A.
If you then try to paste 6 rows of information starting at that cell, there won't be room to do so - there is only one row of "pastable" area to use.
You are probably wanting to find the row following the last used cell in that column, so your code should be:
rngCalcTemplate.Copy shtDest.Range("A" & shtDest.Rows.Count).End(xlUp).Offset(1, 0)
Related
I'm trying to copy a column from a table without it's header and transposing it into another part of the workbook.
To do so I've taken a piece of code that I've used before but can't quite tweak it to do what I want.
I was wondering if you could please help me?
I have table in "sheet 1" that has two columns and starts in cell "A3". I'm trying to copy column B, without the header, and transpose it into "sheet 2" from the cell "J2".
I can't do it via the macro recorder because if the table in sheet 1 only has one row it won't transpose into sheet 2 because it copies too many cells (and I'm learning more on how to avoid macro recorder).
This is the code I've tweaked, any help on how I can change it or use a better code?
'
' Macro21 Macro
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")
'1. Find last used row in the copy range based on data in column 1
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
'2 Find first bnak row in the destination range based in column B
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("B4").Copy wsDest.Range("J2" & lDestLastRow)
End Sub
Thanks
To copy a range and then paste it transposed, you can of course use .Copy and .PasteSpecial Transpose:=True, but it will be much better to resize your destination range in such a way that you shift the orientation of your copy range, and then to apply Application.Transpose() to the rngCopy.Value.
This code should do it. Some elaboration on your comments in there to explain what everything does.
Sub TransposeRangeColumn()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim rngCopy As Range
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")
'1. Find last used row in the copy range based on data in column B (!? you had "column 1")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
'2. Set rngCopy
Set rngCopy = wsCopy.Range("B4:B" & lCopyLastRow)
'3. a) Resize destRang transposed. Example:
'Range("A1").Resize(RowSize=2, ColumnSize=3) would get you Range("A1:C2")
'we need to transpose, so input .Resize(rngCopy.ColumnSize, rngCopy.RowSize) instead
'we have 1 column, so just use 1 for the row; for columns, count rows rngCopy
'b) now that we have a transposed destination range, we want to set its value equal to
'a transposed version of rngCopy using Application.Transpose()
wsDest.Range("J2").Resize(1, rngCopy.Rows.Count).Value = Application.Transpose(rngCopy.Value)
'Code below would also have worked, but try to grow accustomed to using .Value = .Value instead
'it gives way better performance
'rngCopy.Copy
'wsDest.Range("J2").PasteSpecial Transpose:=True, Paste:=xlPasteValues
End Sub
You mentioned that your range is a table. If it is an actual Excel Table, you don't have to worry about finding/defining the first and last row of rngCopy. You can just set your range to the .DataBodyRange of the specific column you want (here: Column 2). Like this:
Sub TransposeTableColumn()
'Transpose if it's an actual table
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim rngCopy As Range
Set wsCopy = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")
'Use your table name instead of "Table1"
Set rngCopy = wsCopy.ListObjects("Table1").ListColumns(2).DataBodyRange
wsDest.Range("J2").Resize(1, rngCopy.Rows.Count) = Application.Transpose(rngCopy.Value)
End Sub
No need to use the clipboard and copy/paste operations. Do I direct write to cells and use WorksheetFunction.Transpose() to make the column into a row
Here is the code that worked for me
Option Explicit
Public Sub TestCopy()
CopyColumnTransposedTo
Sheets("Sheet1").Range ("A3"), _
2, _
Sheets("Sheet2").Range("J2")
End Sub
Public Sub CopyColumnTransposedTo(ByVal r_table As Range, column As Long, ByVal r_destination As Range)
' Move to the column on table
Set r_table = r_table.Cells(1, column)
' Count rows from end
Dim ws As Worksheet
Set ws = r_table.Worksheet
Dim count As Long
count = ws.Cells(ws.Rows.count, r_table.column).End(xlUp).Row - r_table.Row + 1
If count > 0 Then
' Copy transpose to destination
r_destination.Resize(1, count) = _
WorksheetFunction.Transpose( _
r_table.Resize(count, 1).Value)
End If
End Sub
Example results
i have the following problem. I want to write a Macro, that copies three specific columns from a file "Rest.xlsx" into the original file "Schweben.xlsm". Both files are attached.
I already have the following code, which copies specific columns within the original file "Schweben.xlsm" from the table1 to a new created table2. Now i also want the macro to copy the columns K,H,D form Rest.xlsx to table2 within the "Schweben.xlsm" file into the new columns F,G,J (in that specific order). Since the files change daily, I want the macro to recognize the different lengths of the columns and always recognize all cells within the column, even if it is sometimes longer.
Sub CopyRowE()
Dim LastRowE As Long
Dim LastRowH As Long
Dim LastDataRow As Long
Dim CopyData As Long
With Tabelle1
LastRowE = .Range("E9999").End(xlUp).Row
LastRowH = .Range("H9999").End(xlUp).Row
.Range("E2:E" & LastRowE).Copy
.Range("CA1").PasteSpecial
.Range("H2:H" & LastRowH).Copy
.Range("CB1").PasteSpecial
LastDataRow = .Range("CB999999").End(xlUp).Row
.Range("CA1:CB" & LastDataRow).Copy
Sheets.Add
ActiveSheet.Range("A1").PasteSpecial
.Range("CA1:CB" & LastDataRow).ClearContents
Tabelle1.Select
.Range("A1").Select
End With
End Sub
Thanks in advance
Here is a simplified approach to copy columns of data from one sheet to another. I've matched what you asked for as best as I could understand your needs and commented the code well, so you can follow it. The important part here is the creation of a sub procedue that named "copy_column" that actually doest he copying when supplied with a source and destination cell.
Sub copyRowE()
Dim new_sheet As Worksheet
Dim source As Range
Dim dest As Range
Dim rest_sheet As Worksheet
'this code assumes that the Rest.xlsx workbook is open, if not, correct the
'following line and remove the comment character (')
'workbooks.open("c:\full\path\to\Rest.xlsx")
' copy E from tabelle1 to column A on new sheet
Set new_sheet = ThisWorkbook.Sheets.Add
'give new_sheet a name
'new_sheet.name = "Consolidated"
copy_column tabelle1.Range("E2"), new_sheet.Range("A1")
'copy H from tabelle1to column B on new sheet
copy_column tabelle1.Range("h2"), new_sheet.Range("B1")
'copy from the first sheet in rest.xlsx
Set rest_sheet = Workbooks("Rest.xlsx").Worksheets(1)
'OR copy from a particular sheet in Rest.xlsx
'Set rest_sheet = Workbooks("Rest.xlsx").Worksheets("Sheet1")
'copy column K from rest to column F on the new sheet
copy_column rest_sheet.Range("K2"), new_sheet.Range("F1")
'copy column H from rest to column G on the new sheet
copy_column rest_sheet.Range("H2"), new_sheet.Range("G1")
'copy column D from rest to column J on the new sheet
copy_column rest_sheet.Range("D2"), new_sheet.Range("J1")
End Sub
Sub copy_column(top_cell_in_source_column As Range, dest_cell As Range)
' copies data starting at top_cell_in_source_column and taking all data below it
' and pastes it beginning at dest_cell. The source and destination can be in
' different worksheets or even in different workbooks
Dim source_sheet As Worksheet
Dim source_col As Long
Set source_sheet = top_cell_in_source_column.Parent
source_col = top_cell_in_source_column.Column
Range(top_cell_in_source_column, source_sheet.Cells(source_sheet.Rows.Count, source_col).End(xlUp)).Copy dest_cell
End Sub
I want to make variable C into the selection cell
like this
Dim c= selection area
I tried this code:
ActiveCell.Value
but doesnt' working..
Selcetion cell is always change.. so can't use range(null:null)
Sub noname1()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim B As String
Dim C
B = Cells(20, 87).Value
C = Selection
'Set variables for copy and destination sheets
Set wsCopy = Workbooks("source.xlsx").Worksheets("5.588")
Set wsDest = Workbooks("dest.xlsx").Worksheets(B)
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range(C).Copy _
wsDest.Range("A" & lDestLastRow)
'Optional - Select the destination sheet
wsDest.Activate
End Sub
A "Range" can be a single cell or any number of cells together. Since all cells are on one sheet or another every range is on a sheet as well. A range can't include cells from more than one sheet.
All sheets are in workbooks. No sheet can be in more than one workbook. Therefore no range can be spread over more than one workbook.
To specify a range you need to tell the workbook, the worksheet, its first cell and its last cell. If you don't specify the workbook the ActiveWorkbook will be presumed. If you don't specify the worksheet, the ActiveSheet will be presumed. Therefore
Range("B5:D15")
' is the same as
Activeworkbook.ActiveSheet.Range("B5:D15")
You don't need to select a range in order to copy, clear, delete or modify it. VBA's Selection object supports the user's selection on the screen but otherwise largely mirrors the Range object which disregards the screen. Therefore, if you select B5:D15 and enter ? Selection.Address(0,0) in the Immediate pane the answer will be "B5:D15". You will get the same reply if you enter ? Range("B5:D15").Address(0,0).
In my example, B5 and D15 are the first and last cells of the range. Excel creates a range name from these coordinates which is presented in inverted commas because it's a string. However, you can also specify the same cells as members of the Cells collection (all cells in a range - by default the entire sheet).
Debug.Print Range("B5:D15").Address
Debug.Print Range(Cells(5, 2), Cells(15, 4)).Address
The two lines of code print the same response but the second one is much easier to create using variables, such as changing row or column numbers.
So, now you can see what the code below would do.
Range(Cells(5, 2), Cells(15, 4)).Copy Destination:=Sheet2.Cells(1, 1)
sorry guys I am conscious this is really simple but its been very frustrating trying to figure this out last hour.
I would like to have the value "427" (Column D) go all the way down to the end of the last line of range. (Row 32) As it is a dynamic range, the range will have new entries over time. I used the following code to do it
Sub EnterRemainingValues()
Dim Workbook As Workbook
Dim lastrow As Long
Set Workbook = Workbooks("Workbook 1") 'name of workbook
lastrow = Worksheets("Sheets1").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet1").Range("D14:D" & lastrow).Value = "427"
The issue I believe i'm having is because the range starts from A13 rather than A1, so the values 427 only fill up the first 3 rows which corresponds to the height of the worksheet title (A1:A3). The code thinks thats the lastrow. What I would like is to fill column D with "427" all the way down to the last row starting from row 14. Thank you
EDIT: I forgot to mention - I am controlling "workbook1" which contains the range pictured from a different workbook ("workbookfinal")
Try this:
Option Explicit
Sub EnterRemainingValues()
' Define workbook.
Dim wb As Workbook ' You might need to use '.xlsm'
Set wb = Workbooks("Workbook 1") ' name of workbook
' Define worksheet.
Dim ws As Worksheet
Set ws = wb.Worksheets("Sheet1")
' Calculate last row.
Dim lastrow As Long
lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' Write values.
ws.Range("D14:D" & lastrow).Value = "427"
End Sub
I have code to copy a Worksheet A, columns A:C (no set row quantities, this will be re-used and the quantities will change) and paste to the first blank row in the same workbook, different sheet, Worksheet B (this also has no set row quantities and will change).
Worksheet B has a formula in the same columns that I want to paste to that returns "" if there is no data. I think VBA is seeing the "" and assuming there is data there; however, it is not pasting even to lines without said formula.
Sub Copy_Created_Fringe_Accounts()
Dim SourceRange As Range
Dim DestRange As Range
Dim DestSheet As Worksheet
Dim LastRow As Long
'Source sheet and range
Set SourceRange = Sheets("CREATED FRINGE ACCTS").Range("A2:C500")
'Destination sheet and range
Set DestSheet = Sheets("99 BUDGET WORKSHEET")
'Last Row
LastRow = DestSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Copy and paste to destination
Set DestRange = DestSheet.Range("A" & LastRow + 1)
SourceRange.Copy DestRange
End Sub
Nothing happens when I run it. I expect to see the data from Worksheet A copied to Worksheet B, starting at the first available empty row.
I am fairly new to VBA so any help/understanding is appreciated.
Finding the last row
Try using UsedRange to find the last used row as this is safer than using Find.
LastRow = DestSheet.UsedRange.Rows.Count
A side note
If your code resides in the same place as these worksheets then I would recommend using their code name. This will protect you from running into an error if the sheet doesn't exist.