I would like to paste directly below data I already have in a column starting at a specific cell however since there is already data in the column I will need to paste the data starting at cell A7.
Any suggestions?
Dim copyNames1 As Range, pasteNames1 As Range
Set copyNames1 = Workbooks("2019 11 November.xls").Worksheets(3).Columns("F")
Set pasteNames1 = Workbooks("VBA Workbook.xlsm").Worksheets(1).Columns("A").Offset(7, 0)
copyNames1.Copy Destination:=pasteNames1
End Sub
This code isn`t working as it returns an error and messes up the rest of the data by repositioning it.
EDIT: Here is another alternative I have tried:
' Activate cell directly below pasted data
Range("A1").End(xlDown).Offset(1, 0).Activate
' CR CARDS
'
' NAMES
Dim copyNamess As Range, pasteNamess As Range
Set copyNamess = Workbooks("2019 11 November.xls").Worksheets(3).Columns("F")
Set pasteNamess = Workbooks("VBA Workbook.xlsm").Worksheets(1).ActiveCell
copyNames1.Copy Destination:=pasteNames1
End Sub
Try this... I added worksheet variables, used resize and incorporate the last row.
'Define your variables
Dim cpyws As Worksheet, pstws As Worksheet, copyNames1 As Range, pasteNames1 As Range
'Assign your worksheet variables
Set cpyws = Workbooks("2019 11 November.xls").Worksheets(3)
Set pstws = Workbooks("VBA Workbook.xlsm").Worksheets(1)
'Assign your copy/paste range variables
Set copyNames1 = cpyws.Cells(1, 6).Resize(cpyws.Cells(cpyws.Rows.Count, 6).End(xlUp).Row) 'I like to use resize and incorporate the last row
Set pasteNames1 = pstws.Cells(pstws.Rows.Count, "A").End(xlUp).Offset(1) 'Set start cell to paste your copied range to
'Copy/Paste
copyNames1.Copy Destination:=pasteNames1
Related
I have a worksheet which has different data on it. I want to copy, transpose paste each row in a specified range onto a separate worksheet for each row. I'm pretty much stuck as I'm fairly new to this.
I don't quite understand where to proceed from this.
Sub LoopRow()
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("A6:AI57")
For Each row In rng.Rows
End Sub
Use this code:
All you need to do is change the Sheet Name. We are looping through the specified range and copy pasting each row on another sheets column with Transpose.
Sub LoopRow()
Dim rng As Range
Dim row As Range
Dim cel As Range
Dim i As Integer
Set rng = Worksheets("Name of sheet where data is").Range("A6:AI57")
i = 1
For Each row In rng.Rows
row.Copy
Worksheets("Name where you want your data to go").Cells(1, i).PasteSpecial Transpose:=True
i = i + 1
Next
End Sub
It will paste the data from 1st cell. You can change that by changing cells(2,i) for second and so on.
try this macro
Option Explicit
Sub TranPose_Range()
Dim rng As Range
'Source_sheet====>> name of sheet where the data is
'Target_sheet====>> name of sheet where you want your data to go
Set rng = Sheets("Source_sheet").Range("A6").CurrentRegion
rng.Copy
Sheets("Target_sheet").Cells(1, 1).PasteSpecial , Transpose:=True
End Sub
The code I have runs but it does not do what I intend in the last line. The line at the end pastes the formula but it does not adjust the formula for the new cell.
As an example If the formula im copying is is A3 and the formula is A3=A1+A2, when it is pasted into A10 the formula is still A1+A2 instead of A9+A8.
I tried using paste special but I cannot get that to work. I do not want to select a new active cell as I will have to return back to the original active cell and reference it again.
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+Z
'
Dim StartCell As Range
Dim copyRance As Range
Dim dataSheet As Worksheet
Dim destSheet As Worksheet
Set dataSheet = Sheets("Macro (insert data)")
Set destSheet = Sheets("Jun-2019")
Set StartCell = ActiveCell
Set copyRange = dataSheet.Range("G4:Q4")
ActiveCell.Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value
Set copyRange = dataSheet.Range("W4:AG5")
destSheet.Range("C42").Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value
Set copyRange = destSheet.Range("N10:X10")
StartCell.Offset(0, 11).Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Formula
End Sub
From comments, it seems that you want to copy the Formula, and then convert it to values. This needs to be done in 2 stages, optionally with an explicit .Calculate in case Calculation is set to Manual:
Set copyRange = dataSheet.Range("G4:Q4")
'Copy formulas to ActiveCell
copyRange.Copy Destination:=ActiveCell
With ActiveCell.Resize(copyRange.Rows.Count, copyRange.Columns.Count)
'Force the calculation
.Calculate
'Keep just the values
.Value = .Value
End With
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)
I have a workbook with about 63 sheets. I'd like to take all filtered data (filtered by a macro) from all worksheets and paste them into a separate worksheet.
Worksheets DON'T have the same data range. They all would start on Column A Row 15 IF there is any data there at all. The filter macro filters for specific values in one of the columns hence the differentiation between rows in each sheet.
I need to copy all filtered data starting with a Range of A15 and the last row in the range would be AI. It's just a matter of how many rows if there are any rows to get the number for the AI in the range to copy over.
I got it to copy an entire sheet, not the filtered data, to another sheet but it only copied sheet 1.
Sub rangeToNew_Try2()
Dim newBook As Excel.Workbook
Dim rng As Excel.Range
Set newBook = Workbooks.Add
Set rng = ThisWorkbook.Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeVisible)
rng.Copy newBook.Worksheets("Sheet1").Range("A1")
End Sub
You can use Worksheet.UsedRange to give you just the Range with data in, then you could apply your Range.SpecialsCells to give you just the filtered data.
To help debug your code, set a breakpoint and use the Immediate Window to see what the range is, i.e.:
?rng.Address
(The question mark prints out whatever follows.)
This function should do what you need:
Sub CopyFilteredDataToNewWorkbook()
Dim newBook As Excel.Workbook
Dim rng As Excel.Range
Dim sht As Excel.Worksheet
Dim rowoffsetcount As Long
Dim newsht As Excel.Worksheet
Set newBook = Workbooks.Add
' ThisWorkbook.Worksheets is the same as the Sheets or Worksheets object, but more explicit
For Each sht In ThisWorkbook.Worksheets
' Get the used rows and columns
Set rng = sht.UsedRange
' Offset the range so it starts at row 15
rowoffsetcount = 15 - rng.Row
Set rng = rng.Offset(rowoffsetcount)
' Check there will be something to copy
If (rng.Rows.Count - rowoffsetcount > 0) Then
' Reduce the number of rows in the range so it ends at the same row
Set rng = rng.Resize(rng.Rows.Count - rowoffsetcount)
' Check that there is a sheet we can copy it to
On Error Resume Next
Set newsht = Nothing
Set newsht = newBook.Worksheets(sht.Index)
On Error GoTo 0
' We have run out of sheets, add another at the end
If (newsht Is Nothing) Then
Set newsht = newBook.Sheets.Add(, newBook.Worksheets(newBook.Worksheets.Count))
End If
' Give it the same name
newsht.Name = sht.Name
' Get the range of visible (i.e. unfiltered) rows
' (can't do this before the range resize as that doesn't work on disjoint ranges)
Set rng = rng.SpecialCells(xlCellTypeVisible)
' Paste the visible data into the new sheet
rng.Copy newsht.Range("A1")
End If
Next
End Sub
In reference to: Copy a row in excel if it matches a specific criteria into a new worksheet
I attempted applying the above hyperlink code to the needs of my own workbook. The only notable differences are: Object names, My data begins in "A2" instead of "A1", and my data is being copied to "L" column in a new worksheet instead of "A" column
Also... you can assume I have generated tabs in excel that correspond with each SelectCell.Value.
Sub Consolidate_Sheets()
Dim MyCell As Range
Dim MyRange As Range
Dim ws As Worksheet
Set MyRange = Sheets("Install_Input").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Call superSizeMe(MyCell, MyRange)
Sub superSizeMe(SelectCell As Range, SelectRange As Range)
Dim InstallInput As Worksheet
Dim strPasteToSheet As String
'New worksheet to paste into
Dim DestinationSheet As Worksheet
Dim DestinationRow As Range
'Define worksheet with input data
Set InstallInput = ThisWorkbook.Worksheets("Install_Input")
For Each SelectCell In SelectRange.Cells
InstallInput.Select
If SelectCell.Value <> "" Then
SelectCell.EntrieRow.Select ''''LOCATION OF RUN-TIME ERROR 438''''
Selection.Copy
Set DestinationSheet = Worksheets(SelectCell.Value)
Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
Range("L" & DestinationRow.Rows.Count + 1).Select
ActiveSheet.Paste
End If
Next SelectCell
InstallInput.Select
InstallInput.Cells(1, 1).Select
If IsObject(InstallInput) Then Set InstallInput = Nothing
If IsObject(SelectRange) Then Set SelectRange = Nothing
If IsObject(SelectCell) Then Set SelectCell = Nothing
If IsObject(DestinationSheet) Then Set DestinationSheet = Nothing
If IsObject(DestinationRow) Then Set DestinationRow = Nothing
End Sub
I am getting a Run-time error'438'
"Object doesn't support this property or method" on "SelectCell.EntireRow.Select"
Well your code has a typo
SelectCell.EntrieRow.Select
should say entire not Entrie. Personally I would use this method anyway, It selects the entire row based on the number you put in. FYI there is also a corresponding Columns().select if you need it in the future
sel_cell_row = SelectCell.Row
Rows(sel_cell_row).select
edit addressed to comment
The reason you get the 1004 error is like it says, the copy and paste areas don't match. Think of copying 10 rows, and trying to paste it into 2 rows, simply wouldn'y work. I'm guessing the problem actually stems from your destinationrows code. I'm not entirely sure what its trying to do, but here are two generic fixes
1)keep the copy code as it is, and modify the paste. Instead of selecting a range of cells to paste into, select the first cell (if your range was a1:a10, selecting a1 is sufficient) excel will then paste all the data starting at that first cell. so in your code do this
'comment out all this destination row stuff
'Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
'Range("L" & DestinationRow.Rows.Count + 1).Select
Range("L1").select 'only referencing the first cell to paste into
ActiveSheet.Paste
2)rather than selecting an entire row, why not select only the populated values in that row something like
sel_cell_row = SelectCell.Row
lastColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
range(Cells(sel_cell_row ,1),Cells(sel_cell_row ,lastColumn )).select
then do your copy as usual. the 1 is for column 1, or A. I'm assuming the data you want is in one row starting at column A and going till lastColumn. Maybe now this will match your destinationrows code.
3)Com,bine options 1 and 2. so copy only the populated cells, and paste to the first cell in the range