i'm working on a macro that helps me to copy data from one worksheet to another in Excel with on conditions. I tried the following code but i got an object required error
Any help is appreciated
Sub copier()
Dim ws1 As Worksheet, ws2 As Worksheet, src As Range, dest As Range, i As Integer
Set ws1 = Worksheets("Workload - Charge de travail")
Set ws2 = Worksheets("Sheet1")
For i = 2 To ws1.Range("A1").SpecialCells(xlLastCell).Row
Set src = ws1.Range("A" & i & ":AL" & i + 50)
Set dest = ws2.Range("A" & i & ":AL" & i + 50)
If Source.Cells(i, 31).Value = "Completed - Appointment made / Complété - Nomination faite" Then
'(i,31) this is for my drop down list's condition
src.Copy Destination:=dest
dest.Value = dest.Value
End If
Next i
End Sub
Salut, veuyer verifier que "Source", should not be the sheet "src".
I'm also guessing you're trying to copy just one row at a time,
Range("A" & i & ":AL" & i) which is "A2:AL2" rather than
Range("A" & i & ":AL" & i + 50) is "A2:AL52"
Also check that cells(y,31) is intended to be "AE", which is before AL (column 38).
You use Source instead of src
If Source.Cells(i, 31).Value = "Completed - Appointment made / Complété...
There are a few problems, Source should not be src it should be ws1. src.cells(i ...) will go to the i row after the row src is already referencing. If i is 50 then it will get the result from row 100.
Also I belive you only want one row copied at a time instead of 50 rows.
Sub copier()
Dim ws1 As Worksheet, ws2 As Worksheet, src As Range, dest As Range, i As Integer
Set ws1 = Worksheets("Workload - Charge de travail")
Set ws2 = Worksheets("Sheet1")
For i = 2 To ws1.Range("A1").SpecialCells(xlLastCell).Row
Set src = ws1.Range("A" & i & ":AL" & i)
Set dest = ws2.Range("A" & i & ":AL" & i)
If ws1.Cells(i, 31).value = "Completed - Appointment made / Complété - Nomination faite" Then
'(i,31) this is for my drop down list's condition
src.Copy Destination:=dest
'dest.value = dest.value
End If
Next i
End Sub
Related
I am not getting dynamic range work sheet name in formula. Can anyone assist on this? I get the active sheet range in the formula as =COUNTIF(I3:I31,A3)
Sub Test_DaySumm()
Dim Rg As Range
wksMain.Select
Dim ws1 As Worksheet
Set ws1 = wksMain
If ws1.FilterMode = True Then ws1.ShowAllData
LastRow = ws1.Cells(Rows.Count, "I").End(xlUp).Row
Set MyRange = ws1.Range(Cells(3, 9), Cells(LastRow, 9))
wksDaySummary.Select
xRow = 3
Do Until wksDaySummary.Cells(xRow, 1) = ""
Set Rg = wksDaySummary.Cells(xRow, 2)
Rg.Formula = "=COUNTIF( " & MyRange.Address(0, 0) & "," & Rg.Offset(0, -1).Address(0, 0) & ")"
Rg.Value = Rg.Value
xRow = xRow + 1
DoEvents
Loop
End Sub
Have a look at the Range.Address Property documentary
.Address(RowAbsolute, ColumnAbsolute, ReferenceStyle, External, RelativeTo)
and use the External:=True parameter get get the worksheet name in the address too:
MyRange.Address(RowAbsolute:=False, ColumnAbsolute:=False, External:=True)
So instead of eg I3:I31 the result would be like 'Main Sheet'!I3:I31
I'm working on a macro that helps me to copy data from one worksheet to another in Excel with some conditions. I tried the following code; it works, but I got an infinite loop and I was not able to make the condition correctly in the code (I have to copy only the lines with the drop down list displays (complete), actually it's filled with 3 options (complete/cancel/in process)
Sub copier()
Dim ws1 As Worksheet, ws2 As Worksheet, src As Range, dest As Range, i As Integer
Set ws1 = Worksheets("Workload - Charge de travail")
Set ws2 = Worksheets("Sheet1")
For i = 2 To ws1.UsedRange.Rows.Count
Set src = ws1.Range("A2" & i & ":AG10" & i)
Set dest = ws2.Range("A2" & i & ":AG10" & i)
If Source.Cells(1, 4).Value = "complete" Then
src.Copy Destination:=dest
dest.Value = dest.Value
Next i
End If
End Sub
Here some changes to your code that might help.
Sub copier()
Dim ws1 As Worksheet, ws2 As Worksheet, src As Range, dest As Range, i As Integer
Set ws1 = Worksheets("Workload - Charge de travail")
Set ws2 = Worksheets("Sheet1")
For i = 2 To ws1.Range("A1").SpecialCells(xlLastCell).Row
' this is more reliable than the method you used (which relies ont eh workbook being saved)
' but there must be no gaps in column A.
' Your code would not work. Think about whay happens as i increases!
' ws1.Range("A2" & i & ":AG10" & i)
Set src = ws1.Range("A" & i & ":AG" & i+10 )
Set dest = ws2.Range("A" & i & ":AG" & i+10 )
If Source.Cells(1, 4).Value = "complete" Then
' what is source?
' What is this trying to do! I think you mean i+1 not 1.
' I think you mean src not source. I'm not psychic.
src.Copy Destination:=dest
dest.Value = dest.Value
End If
Next i
End Sub
i have 2 sheeets. basically ws1 is the destination, ws2 is the source. then i have 2 criterias, an ID Number, and a name of the person who will work on the ID Number.
source contains a row with new actions/progress done by "working person" and need to paste it on the destination in order to update it.
I've read around and saw that autofilter looks like the way to go. i have a code here that autofilters, but i'm just not sure how i can "attack" the problem.
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrowDest As Long, currow As Long, lastrowSrc As Long
Dim critvalue1 As String
'Destination sheet (dashboard)
Set ws1 = Sheets("Destination")
'Source Sheet (source)
Set ws2 = Sheets("Source")
lastrowSrc = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
lastrowDest = ws1.Range("A" & Rows.Count).End(xlUp).Row
For currow = 2 To lastrowSrc
critvalue1 = ws2.Range("E" & currow).Value
ws1.Range("A1").AutoFilter field:=5, Criteria1:=critvalue1
Next currow
end sub
is there an easy way to copy the row from source to destination provided that the IDnumber matches? (the IDnumber is unique)
the code above filters but i'm not sure of how to copy or move the rows.
thanks in advance.
This could be done with SUMPRODUCT or VLOOKUP but if you are set on VBA then try this
Sub copyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrowDest As Long, currowSrc As Long, currowDest As Long, lastrowSrc As Long
Dim critvalue1 As String
Set ws1 = Sheets("Sheet2")
Set ws2 = Sheets("Sheet1")
lastrowSrc = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row - 1
lastrowDest = ws1.Range("A" & Rows.Count).End(xlUp).Row
For currowSrc = 2 To lastrowSrc
critvalue1 = ws2.Range("E" & currowSrc).Value
ws2.Cells(6, 5).Value = critvalue1
For currowDest = 2 To lastrowDest
If ws1.Range("E" & currowDest).Value = critvalue1 Then
ws2.Rows(currowSrc).Copy Destination:=ws1.Range("A" & currowDest)
End If
Next currowDest
Next currowSrc
End Sub
I find it easier than dealing with the autofilter. It goes row by row from the source sheet and checks for a match in every row of the destination sheet. If there is a match, the source row in copied to the matching destination row.
To keep formatting instead of
ws2.Rows(currowSrc).Copy Destination:=ws1.Range("A" & currowDest)
use
ws2.Rows(currowSrc).Copy
ws1.Range("A" & currowDest).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
I pulled this out of a larger macro I use and made some changes to make it match your method a little better and I deleted some irrelevant stuff. The variable names are a bit different. I believe this does what you need. Let me know if it gives you trouble.
Don't forget to populate the ID and Name arrays, set the value for the 2 column variables and assign the sheet names before running.
Sub copyByAutofilter()
Dim filterList1 As Variant
filterList1 = Array("ID1", "ID2")
filterCol1 = 1 'or whatever column contains the IDs
Dim filterList2 As Variant
filterList2 = Array("Name1", "Name2")
filterCol2 = 2 'or whatever column contains the names
Dim sourceWB As String
sourceWB = ThisWorkbook.Name
Dim sourceWS As String
sourceWS = "Sheet2"
Dim destinationWB As String
destinationWB = ThisWorkbook.Name
Dim destinationWS As String
destinationWS = "Sheet3"
lastrowSrc = Sheets(sourceWS).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
lastrowDest = Sheets(destinationWS).Range("A" & Rows.Count).End(xlUp).Row
Workbooks(sourceWB).Sheets(sourceWS).AutoFilterMode = False
Workbooks(sourceWB).Sheets(sourceWS).Range("$A$1:$O" & lastrowSrc).AutoFilter Field:=filterCol1, _
Criteria1:=filterList1, Operator:=xlFilterValues
Workbooks(sourceWB).Sheets(sourceWS).Range("$A$1:$O" & lastrowSrc).AutoFilter Field:=filterCol2, _
Criteria1:=filterList2, Operator:=xlFilterValues
Workbooks(sourceWB).Sheets(sourceWS).Range("A2:O" & lastrowSrc).SpecialCells _
(xlCellTypeVisible).Copy _
Destination:=Workbooks(destinationWB).Sheets(destinationWS).Cells(lastrowDest + 1, 1)
End Sub
One method is by using the Copy method of the Range object. This should generally be avoided though as this overwrites the clipboard. A safer option is to simply use rngDest.Value = rngSrc.Value. Note that for this to work the ranges must be the same size. Here is how this is normally used:
Dim dst As Range
Dim src As Range
Set src = Range("A1:B3") 'Data you want to copy
Set dst = Range("C1") 'First cell in the destination Range
Set dst = dst.Resize(src.Rows.Count, src.Columns.Count) 'Resize to match src
dst.Value = src.Value 'Copy to destination
This method has the benefit of preserving the clipboard!
I want to calculate Sum of different columns in a worksheet and fill it in another worksheet.
LastrowA = Weight.Cells(Weight.Rows.Count, "A").End(xlUp).Row
Set Rng = Weight.Range("A2" & LastrowA)
Weight.Activate
Summ= WorksheetFunction.Sum(Rng) ' Doesn't work
Summary.Cells(1, 1).Value=Summ
Summary.Cells(1, 1).Value = Application.Sum(Rng) ' Doesn't Work
The two Sheets are Weight and Summary. I have tried above two ways and both give me an answer of Zero. I want to continue doing it for all my columns . Please advice. Thank you.
This sub will sum data in Sheet 1 Columns A to C and put results in Sheet2
You can use this sub and just change column letters and output cells.
Hope this helps
Sub SumRange()
Dim wb as Workbook
Set wb = Thisworkbook
Dim ws as worksheet
Set Weight = wb.Sheets("Weight")
LastRow1 = Weight.Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Weight.Range("A2:A" & "" & LastRow1 & "")
Col1Sum = WorksheetFunction.Sum(Rng)
LastRow1 = Weight.Range("B" & Rows.Count).End(xlUp).Row
Set Rng = Weight.Range("B2:B" & "" & LastRow1 & "")
Col2Sum = WorksheetFunction.Sum(Rng)
LastRow1 = Weight.Range("C" & Rows.Count).End(xlUp).Row
Set Rng = Weight.Range("C2:C" & "" & LastRow1 & "")
Col3Sum = WorksheetFunction.Sum(Rng)
ThisWorkbook.Sheets("Sheet2").Cells(2, 2).Value = Col1Sum
ThisWorkbook.Sheets("Sheet2").Cells(3, 2).Value = Col2Sum
ThisWorkbook.Sheets("Sheet2").Cells(4, 2).Value = Col3Sum
End Sub
first of all, i have no excel here, so i cant try by myself what I'm thinking.
but i think you use the Range-Method the wrong way.. it should look like this:
Set Rng = Weight.Range("A2" , Cells( LastrowA , "A") )
so there is a "," between the arguments instead of a "&" an there is a second Cell instead of a row-number.
Hope that helps
the below code is to take an employee name, (Column A) andput the range ("A:J") of that row into a new sheet of that employee, if they dont have a sheet, then make one and ad the heading. However, it is skipping every second line, which is causing the line that it is scanning the name on, and the line it is copying from to be different (ie:Employees are going in the wrong sheets, and only 1/2 are getting moved)
Any help would be great
Set rngEmpSales = wsSales.Range("A2", wsSales.Range("A" & Rows.Count).End(xlUp).Address)
Dim wsSales As Worksheet, wsDesSales As Worksheet
Set wsSales = ThisWorkbook.Sheets("Sales")
Dim SalesCount as Range
For Each SalesCount In rngEmpSales
On Error Resume Next
Set wsDesSales = ThisWorkbook.Sheets(Trim(SalesCount.Value))
On Error GoTo 0
If wsDesSales Is Nothing Then
Set wsDesSales = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsDesSales.Name = SalesCount.Value
End If
SalesCount(1 - (SalesCount.Row - 1)).Range("A1:J1").Copy wsDesSales.Range("K2")
SalesCount.Range("A" & SalesCount.Row & ":J" & SalesCount.Row).Copy wsDesSales.Range("K" & Rows.Count).End(xlUp).Offset(1, 0)
Set wsDesSales = Nothing
End If
Next SalesCount
Is this what you are trying? (UNTESTED)
Sub Sample()
Dim wsSales As Worksheet, wsDesSales As Worksheet
Dim rngEmpSales As Range, SalesCount As Range
Dim shName As String
Dim lRow As Long, i As Long
Set wsSales = ThisWorkbook.Sheets("Sales")
With wsSales
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rngEmpSales = .Range("A2:A" & lRow)
For i = 2 To lRow
shName = Trim(.Range("A" & i).Value)
On Error Resume Next
Set wsDesSales = ThisWorkbook.Sheets(shName)
On Error GoTo 0
If wsDesSales Is Nothing Then
Set wsDesSales = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsDesSales.Name = shName
End If
.Range("A1:J1").Copy wsDesSales.Range("K2")
.Range("A" & i & ":J" & i).Copy wsDesSales.Range("K" & _
wsDesSales.Rows.Count).End(xlUp).Offset(1, 0)
Set wsDesSales = Nothing
Next i
End With
End Sub
You should use
wssales.Range("A" & SalesCount.Row & ":J" & SalesCount.Row) instead of SalesCount.Range("A" & SalesCount.Row & ":J" & SalesCount.Row)
and
wssales.Range("A1:J1").Copy instead of
SalesCount(1 - (SalesCount.Row - 1)).Range("A1:J1").Copy
The reason is SalesCount itself is a range, when you apply another .Range after it, it will take the relative position.
e.g. Range("A2").Range("A1:J1") becomes Range("A2:J2") and Range("B2").Range("B2:K2") becomes Range("B2:K2")