How to copy a range of cells and paste values to two different worksheets? - vba

I have a range of data on Sheet2 that links it to Sheet1 (Sheet1 is formatted and linked by Sheet2 using =if(Sheet2$x$x="","",Sheet2$x$x); this way any data put into the range C13:G62 of Sheet2 shows up in Sheet1 range C13:G62. The beginning portion on the code works to move JUST the data in the specified range to the BATCH file Sheet3 and finds the last row pasting the values from Sheet1 without copying the formulas. It was made this way so I can delete data on Sheet2 to wipe Sheet1 clean but still have all the backup data on one Sheet3.
Anyway, the problem lies when I tried to manipulate the code to copy all contents on Sheet1 (to DUPLICATE SHEET1) to another sheet at the end of the workbook:
Sheets(Sheet1).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = _
InputBox("Name of the New WorkSheet")
This allowed me to name the sheet which was great. However by creating multiple variations of code it will not move the DATA in the RANGE to the newly created Sheet4 (there is no data). In one iteration of code I was able to get Sheet1 to copy and make Sheet4 at the end of the work book with no data in the range but have the cursor land in cell C13, the starting point for pasting just the values, and when I left click the mouse in that cell to "paste values" it would paste the values that I was trying to paste. However, either way I rearranged the code, the data would always be copied but would never paste to the Sheet4 range.
Here I have posted one variation of the code IN WHICH IT STILL WILL NOT PASTE THE VALUES TO SHEET4 (THE NEWLY CREATED SHEET) but still copies to the BATCH FILE. What am I missing here?
Dim s1Sheet As Worksheet
Dim s2Sheet As Worksheet
Dim source As String
Dim target As String
Dim rngSource As Range
Dim rngTargetStart As Range
source = "Invoice"
target = "TOTAL_INVOICE"
Application.EnableCancelKey = xlDisabled
Set s1Sheet = Sheets(source)
Set s2Sheet = Sheets(target)
Set rngSource = s1Sheet.Range("C13:G62")
Set rngTargetStart = s2Sheet.Range("C" & Rows.Count).End(xlUp).Offset(1)
'Set rngTargetFinish = ws1.Range("C" & Rows.Count).End(xlUp).Offset(1)
rngTargetStart.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
'rngTargetFinish.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
'Set target = Sheets("Sheet4").Range("B13:G63")
copy_non_formulas source:=rngSource, target:=rngTargetStart
' copy_non_formulas source:=Range("B13:G63"), target:=Range("B70:G109") Unhighlight
' copy_non_formulas source:=Range("B13:G63"), target:=Range("B13:G63") Unhighlight
'===Copies Sheet to End of WorkBook & Pastes Values======
Sheets(source).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = _
InputBox("Name of the New WorkSheet")
Range("C13:G62").ClearContents
Dim rng As Range
Set rng = ActiveSheet.Range("C13:G62")
rng.ClearContents
Dim s3Sheet As Worksheet
Dim rngTargetStart2 As Range
Set s3Sheet = Sheets(Sheets.Count)
Set rngTargetStart2 = s3Sheet.Range("C" & Rows.Count).End(xlUp).Offset(1)
rngTargetStart2.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
copy_non_formulas2 source:=rngSource, target2:=rngTargetStart2
copy_non_formulas2 source:=Range("C13:G62"), target2:=Range("C13:G62")
This is an Integrated Public Sub
copy_non_formulas(source As Range, target As Range)
Dim i As Long
Dim j As Long
Dim c As Range
For i = 1 To source.Rows.Count
For j = 1 To source.Columns.Count
Set c = source(RowIndex:=i, ColumnIndex:=j)
If Left(c.Formula, 1) <> "=" Then
target(RowIndex:=i, ColumnIndex:=j).Value = c.Value
End If
Next j
Next i
And another Public Sub for the Second Move
copy_non_formulas2(source As Range, target2 As Range)
Dim x As Long
Dim y As Long
Dim d As Range
For x = 1 To source.Rows.Count
For y = 1 To source.Columns.Count
Set d = source(RowIndex:=x, ColumnIndex:=y)
If Left(d.Formula, 1) <> "=" Then
target2(RowIndex:=x, ColumnIndex:=y).Value = d.Value
End If
Next y
Next x

Related

copy paste the matched columns from one worksheet to another

I have a question about copy paste specific columns from one worksheet(ws_Copy) to another(ws_Dest). I need to loop through each column header and match it with the headers in ws_Copy. If it matches, I need to copy the whole column into the ws_Dest with the matched header.
Not sure if my explain is clear or not, here is the sample code:
Sub Import_data()
Dim path As String
Dim file As String
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lastcol As Integer
Dim lastrow_ir As Integer
Dim i As Integer
Dim m As Integer
path = ThisWorkbook.Sheets("MACROS").Range("import_path_IRHedge").Value
file = ThisWorkbook.Sheets("MACROS").Range("file_IRHedge").Value
'Set variables for copy and destination sheets
Set wsCopy = Workbooks(file).Sheets("data_ir_bpv")
Set wsDest = ThisWorkbook.Sheets("IR Hedge")
'Find last used column in the destination sheet
'Find last row in the copy sheet
lastcol = wsDest.Range("C:AD").Column
lastrow_ir = wsCopy_ir.Range("C" & Rows.Count).End(xlUp).Row
'Use the Match function to find the corresponding column to copy paste
For i = 3 To lastcol
Set Rng1 = wsCopy_ir.Range("C14:AC14")
m = Application.WorksheetFuntion.Match(wsDest.Cells(1, i).Value, Rng1, 0)
wsCopy_ir.Range("C14:C & lastrow_ir").Columns(m).Copy
wsDest.Range("C2").Columns(i).PasteSpecial xlPasteValues
Next i
Application.CutCopyMode = False
MsgBox "Data has been imported successfully"
End Sub
But the error message "Object doesn't support this property or method" kept showing up in the row:
m = Application.WorksheetFuntion.Match(wsDest.Cells(1, i).Value, Rng1, 0)
Any help would be appreciated!

Excel VBA Array list

I am a toddler in VBA
I have a large range this could be more than 1000 text values (This could be going down A1), I am trying to concatenate all values with quote and comma into one cell (C1), i know of the transpose formula, but I am not sure my vba array will recognise this as a list.
I am keen for my array formula to recognize c1 as list, in order to carry out my action.
I am really keen to keep this clean and not use the concatenation and drag various formulas down.
I came across this, but this does not paste all the values into one cell.
Sub transpose()
Dim rng As Range
Dim ws As Worksheet
Dim last As Range
Set ws = ActiveSheet
Set last = ws.Cells(Rows.Count, "A").End(xlUp)
Set rng = ws.Range("A1", last)
For Each cell In rng
Dim hold As String
hold = """"
hold = hold + cell.Value
hold = hold + """" + ", "
cell.Value = hold
Next cell
rng.Copy
ActiveWorkbook.Sheets(2).Range("A1").PasteSpecial transpose:=True
End Sub
Code done by ryan E
If anyone can suggest any cheats on gathering list for Arrays that would be great. Other than using the Macro tool in excel
Example.
A1 = company1
A2 = company2
etc
Solution
C1 would show in one cell "company1", "company2", .... "company10000"
You can use Join() and Transpose().
For example:
Sub transpose()
Dim rng As Range
Dim ws As Worksheet
Dim last As Range
Set ws = ActiveSheet
Set last = ws.Cells(Rows.Count, "A").End(xlUp)
Set rng = ws.Range(ws.Range("A1"), last)
ws.Range("B1").Value = """" & Join(Application.Transpose(rng.Value), """,""") & """"
End Sub
EDIT: now I see what you really want to do (create an array of sheet names to pass to Sheets.Copy()) here's one approach...
Add a sheet named (eg) "Groups" to hold your various lists of sheets to be copied:
Group names are in Row 1, with a list of sheets below each name.
Then use this code:
'to demo the "CopySheets()" sub...
Sub Tester()
CopySheets "Group2" 'copy all sheets in Group2
End Sub
'Create of copy for all sheets under "GroupName" header...
Sub CopySheets(GroupName As String)
Dim rng As Range, arr
Dim ws As Worksheet
Dim f As Range
Set ws = ThisWorkbook.Sheets("Groups") '<< has lists of sheet names
'find the header for the group to be copied
Set f = ws.Rows(1).Find(GroupName, lookat:=xlWhole)
If Not f Is Nothing Then
'found the header, so create an array of the sheet names
Set rng = ws.Range(f.Offset(1, 0), ws.Cells(ws.Rows.Count, f.Column).End(xlUp))
arr = Application.transpose(rng.Value)
'use the array in the sheets Copy method
ThisWorkbook.Sheets(arr).Copy
Else
'alert if you tried to copy a non-existent group
MsgBox "Sheet group '" & GroupName & "' was not found!"
End If
End Sub

Excel Copy whole row from a sheet to another sheet based on one column value

I need to copy an entire row from a sheet and paste in another sheet with same header consider a particular column value is equal to 89581.But my VBA throws 424 error.Please help.
Sub CopyData()
Dim c As Range
Dim Row As Long
Dim sheetUse As Worksheet
Dim sheetCopy As Worksheet
Set sheetUse = Sheets("Data1").Select
Set sheetCopy = Sheets("Data2").Select
Row = 3 'Assume same header in sheet2 as in sheet1
For Each c In sheetUse.Range("O3", Sheet1.Range("O65536").End(xlUp))
If c = 89581 Then
'copy this row to sheet2
Row = Row + 1
c.EntireRow.Copy sheetCopy.Cells(Row, 1)
End If
Next c
Application.CutCopyMode = False
End Sub
Here you go, build a reference to copy then copy and paste in one go.
Sub CopyToOtherSheet()
Dim sheetUse As Worksheet, sheetCopy As Worksheet, i As Long, CopyRange As String
Set sheetUse = Sheets("Data1")
Set sheetCopy = Sheets("Data2")
For i = 3 To sheetUse.Cells(Rows.Count, 15).End(xlUp).Row
If sheetUse.Cells(i, 15) = 89581 Then CopyRange = CopyRange & "," & i & ":" & i
Next i
sheetUse.Range(Right(CopyRange, Len(CopyRange) - 1)).Copy
sheetCopy.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll 'Change to values or formats or whatever you want
Application.CutCopyMode = False
End Sub
Assumed Data1 is the sheet with the data in and Data2 is the one to copy to.

finding the next empty cell so that it wont overwrite the previous pasted data

I am having a problem to consolidate data from multiple worksheet into a summary worksheet. It is able to copy all the data except when the data is pasted it will overwrite the previous data. Example data in sheet A is pasted to recompile sheet starting from range A2. The problem is data in sheet B,C,D etc will also be pasted starting from range A2 causing it to overwrite each other.
This is my code.
Private Sub CommandButton2_Click()
Dim Sheetname, myrange As String
Dim A, noOfrows As Integer
Dim startRow As Integer
For i = 2 To Worksheets("Master Sheet").Cells.SpecialCells(xlCellTypeLastCell).Row
Sheetname = Worksheets("Master Sheet").Cells(i, 27).Value'All the sheets that suppose to transfer to recompile sheet
noOfrows = Worksheets(Sheetname).Cells.SpecialCells(xlCellTypeLastCell).Row
myrange = "A2:N" & CStr(noOfrows)
Worksheets(Sheetname).Select
Worksheets(Sheetname).Range(myrange).Select
Selection.Copy
Sheets("Recompile").Select
Range("A2").Select
ActiveSheet.Paste
Next i
End Sub
You need to find the UsedRange in the "Recompile" sheet and paste into the range below that:
Something like:
Private Sub CopyData()
Dim A As Long
Dim noOfrows As Long
Dim startRow As Long
Dim i As Long
Dim control As Worksheet
Dim source As Worksheet
Dim target As Worksheet
Set control = Worksheets("Master Sheet")
Set target = Worksheets.Add
For i = 2 To control.UsedRange.Rows.Count
' the target worksheet for this row of data
Set source = Worksheets(control.Cells(i, 1).Value) ' My example has this data in column A
' the address of a range with (number of rows - 1) for columns A:N
source.Range("A2:N" & source.UsedRange.Rows.Count).Copy
target.Range("A" & target.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row).PasteSpecial xlPasteValues
Next i
End Sub
Lots of information and tips here: http://www.rondebruin.nl/win/s3/win002.htm

Copy and Paste Largest value in a column from one workbook to another

I am attempting to first, find the the largest value in a column (C), then copy and paste that value into the next empty cell in 'Row 3' in a different (master) workbook. The macro I am running is found in the master workbook. I found this code that i believe will get the pasted cell into the correct spot, but I could use assistance in the code for how to find the largest cell in column C in the data workbook, and then copying and pasting that value.
Private Sub CommandButton1_Click()
Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextColumn As Long, LastRow As Long
Set wsMaster = ThisWorkbook.Sheets("Contract Metrics")
NextColumn = wsMaster.Range("C", 3).End(xlUp).Column + 1
Set wbDATA = Workbooks.Open("C:\Documents and Settings\Michael Palkovitz\My Documents\Test\Contracts Metrics.xlsx")
wbDATA.Close False
End Sub
Try this. First sort the column you need the value from, then get the last row and place the value into your first empty column in row 3 of your master sheet.
' Create an excel application and open the workbook containing the data
Dim app As Object
Dim wb As Object
Dim ws As Object
Set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Open("C:\Workbook1")
Set ws = wb.Sheets(1)
' Get last row with a value to use for the sort range
Dim last As Long
Dim value As Long
With ws
last = ws.Cells(ws.Rows.Count, 3).End(xlUp).row
.Range("C1:C" & last).Sort Key1:=.Range("C2"), order1:=xlAscending, Orientation:=xlTopToBottom
value = .Cells(last, 3)
End With
' Get the last filled cell and move over one to get the empty column
Dim col As Long
col = ActiveSheet.Cells(3, 1).End(xlToRight).Offset(0, 1).Column
ActiveSheet.Cells(3, col).value = value
wb.Close False
Set ws = Nothing
Set wb = Nothing
Set app = Nothing