I wrote this code and it keeps giving me an error that the size of the copy area and the paste area are not the same.
but if I just use the copy-paste method, it works perfectly. could you pls help me out.
Sub copy()
eRow = Sheet5.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheet4.Range("a4", "d23").copy
Sheet5.Cells(eRow, 1).PasteSpecial (xlPasteValues)
End Sub
Move values one by one with a value transfer. As implied in the name, a value transfer does not carry over formats.
This just copies the 2 individual cells A4 & D23
Sub copy_me()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1).Row
ws.Range("A" & lr).Value = ws.Range("A4").Value
ws.Range("D" & lr).Value = ws.Range("D23").Value
End Sub
If you meant to grab the entire range A4:D23 then
ws.Range("A4:D23").Copy
ws.Range("A" & lr).PasteSpecial xlPasteValues
OR
ws.Range("A" & lr).Resize(20, 4).Value = ws.Range("A4:D23").Value
Related
Hope you're doing great, need help with below code that is supposed to match first column from 2 files then vlookup and copy paste the matched results. the problem is that i'm limited by vlookup range that only works for one column so i tried to make a loop to make it work on multiple number of cells as shown below but it's not working, any help or hints would be really welcomed, Thanks.
edit
the problem lies where iis used in the funcStr for the vlooukp table range and column's number, i need the range to be increased and column number to constinatly change to get the whole row copied instead.
Sub solution()
Dim oldRow As Integer
Dim newRow As Integer
Dim lrow_output As Integer
Dim WB_Input As Workbook
Dim WB_Output As Workbook
Dim WS_Input As Worksheet
Dim WS_Output As Worksheet
Dim funcStr As String
Dim i As Integer
Set WB_Input = Workbooks("File.xlsm")
Set WB_Output = Workbooks("output1.xlsx")
Set WS_Input = WB_Input.Worksheets("input")
Set WS_Output = WB_Output.Worksheets("Sheet1")
With WS_Output
lrow_output = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For i = 2 To 6
With WS_Input
funcStr = "=IFERROR(VLOOKUP(" & Cells(1, 1).Address(False, False) & "," & "'[" & WB_Input.Name & "]" & .Name & "'!" & Range(.Columns(1), .Columns(i)).Address & ",i,0),"""")"
End With
With WS_Output
.Cells(1, i).Formula = funcStr
.Cells(1, i).Copy
Range(.Cells(1, i), .Cells(lrow_output, i)).PasteSpecial xlPasteFormulas
WS_Output.Calculate
Range(.Cells(1, i), .Cells(lrow_output, i)).Copy
Range(.Cells(1, i), .Cells(lrow_output, i)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
Next i
End Sub
I am trying to paste values from a bunch of tables into one long list. I have the tables spread across different sheets and the number of rows changes, but the columns do not. Then I am also trying to paste a string value that tells what sheet it came from, but having trouble with the active cell part of the code.
When I first tried it, it did not compile, hence why I came here, to figure out why it did not compile. Going back and forth with urdearboy, below, I was able to get the correct code working here.
I have the following:
sub copypaste()
Dim ws1 as worksheet
dim ws2 as worksheet
dim mas as worksheet
Set ws1 =ThisWorkbook.Sheets("Sheet1")
Set ws2=ThisWorkbook.Sheets("Sheet2")
Set mas=ThisWorkbook.Sheets("Master") 'where I create my list
For Each ws In Worksheets
If ws.Name <> mas.Name Then
LRow = mas.Range("A" & mas.Rows.Count).End(xlUp).Offset(1, 0).Row
wsLRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A2:A" & wsLRow - 1).Copy
mas.Range("A" & LRow).PasteSpecial Paste:=xlPasteValues
ws.Range("B2:B" & wsLRow - 1).Copy
mas.Range("B" & LRow).PasteSpecial Paste:=xlPasteValues
mas.Range(mas.Cells(LRow, 4), mas.Cells(wsLRow + LRow - 2, 4)) = ws.Name 'I need my sheet value in the fourth column, not the third, but simply change the col coordinate in the Cells equation above
End If
Next ws
'In order to figure out the sheet name, I used the following:
Dim rng As Range
Set rng = mas.Range("D2", Range("D2").End(xlDown))
For Each Cell In rng
If Cell.Value = "Sheet 1" Then
Cell.Value = "S1"
ElseIf Cell.Value = "Sheet 2" Then
Cell.Value = "S2"
End If
Next Cell
end sub
This will loop through all sheets, with the exception of Master, and import the values on Column A to Master accompanied by the origin of the data (sheet name).
Option Explicit for good measure.
Option Explicit
Sub copypaste()
Dim mas As Worksheet: Set mas = ThisWorkbook.Sheets("Master")
Dim ws As Worksheet, LRow As Long, wsLRow As Long
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> mas.Name Then
LRow = mas.Range("A" & mas.Rows.Count).End(xlUp).Offset(1).Row
wsLRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A2:A" & wsLRow).Copy mas.Range("A" & LRow)
mas.Range(mas.Cells(LRow, 2), mas.Cells(wsLRow + LRow - 2, 2)) = ws.Name
End If
Next ws
Application.ScreenUpdating = True
End Sub
To paste values change
ws.Range("A2:A" & wsLRow).Copy mas.Range("A" & LRow)
to this
ws.Range("A2:A" & wsLRow).Copy
mas.Range("A" & LRow).PasteSpecial xlPasteValues
I am a total beginner and appreciate any help I can get.
Sheet1 has a list of 30 markets.
Market1
Market2
.
.
Market30
I have a script that loops through Sheet1 and creates a new sheet for every market.
Sheet2 has all my raw data.
Looping through Sheet2 I need to move every row to its corresponding market. Market ID is in column B.
1-by-1 I can do this with the code below, but how would I put it in a loop?
I want to loop through Sheet1 and for each market ID, use that input as a variable to search Sheet2 and move the entire row to its corresponding market sheet.
Sub Market1()
Dim LR As Long, i As Long
With Sheets("Sheet2")
LR = .Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("B" & i).Value = "Market1" Then .Rows(i).Copy Destination:=Sheets("Market1").Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End With
End Sub
Sub Market2()
Dim LR As Long, i As Long
With Sheets("Sheet2")
LR = .Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("B" & i).Value = "Market2" Then .Rows(i).Copy Destination:=Sheets("Market2").Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End With
End Sub
Thank you
I think this should do what you want. The only tricky thing is adding a sheet if you already have the sheet name. I added a second macro that checks for it and creates if not found. Based on your code (which was a nice example), I think this should work for you.
Sub MarketAny()
Dim LR As Long, i As Long
Dim ws As Worksheet, shName As String
Set ws = Sheets("Sheet2")
LR = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
For i = 1 To LR
shName = ws.Range("B" & i).Value
Call SheetCheck(shName) ' needed to ensure that you don't create a duplicate name
ws.Rows(i).Copy Destination:=Sheets(shName).Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End Sub
Private Sub SheetCheck(nameofSheet As String)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If ws.Name = nameofSheet Then Exit Sub
Next ws
'Creates new sheet
Set ws = Sheets.Add
ws.Name = nameofSheet
End Sub
I have 2 sheets, in one sheet I am looking for a specifik text in a column, if that exists then it should copy all the rows with the specific text and paste them in another sheet. That is working for me, but the problem is that when I want to pastespecial, only paste the values and not the formulas I isn't working.
Here is the code, any idea what to do?
With Sheets(1)
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("A" & i).Value = "Orange" Then .Rows(i).Copy
Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _
Paste:=xlPasteValues
Next i
End With
You have a logic error in the code, which I missed in my comment. You need the PasteSpecial inside the If block:
With Sheets(1)
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("A" & i).Value = "Orange" Then
.Rows(i).Copy
Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _
Paste:=xlPasteValues
End If
Next i
End With
While the answer of Rory should fit perfectly your problem, you could speed it up by a big amount using a variable for the ranges to copy...
Dim rng As Range
With Sheets(1)
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("A" & i).Value = "Orange" Then
If rng Is Nothing Then
Set rng = .Rows(i)
Else
Set rng = Union(rng, .Rows(i))
End If
End If
Next
rng.EntireRow.Copy
Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End With
Written by phone. May contain errors.
Sub test1()
Dim LR As Long
LR = WorksheetFunction.Max(20, Range("C" & Rows.Count).End(xlUp).Row + 1)
Range("C3").Resize(, 3).Cut Destination:=Range("C" & LR)
End Sub
The above source code works to copy(cut) paste into same sheet.
Now i need cut and paste into another sheet
ie: Sheet1(Cut) to sheet2(Past)
Thanks
Below code will cut data from sheet1 to sheet2
Sub test1()
Dim LR As Long
LR = WorksheetFunction.Max(20, Range("C" & Rows.Count).End(xlUp).Row + 1)
Sheets("Sheet1").Range("C3").Resize(, 3).Cut
Sheets("Sheet2").Range("C" & LR).PasteSpecial xlPasteValues
End Sub