Hello everybody, I am new on OZgrid and a noob in vba (6 months or so) but I love it and puting toghether bits and pieces with a lot of forum readings and codes I found online, I already built some nice applications (nice for a noob )
I am currently working on a new project and I have managed to built userforms for it.
I am stuck however at one macro for this project. This macro opens a message box where the user inputs a number (id) that can be found in all sheets in the column I and then it loops in all the sheets and if it finds the ans number then copies/pastes all the entire rows containing that specific ID; it then pastes it on the sheet I specified in the code.
Now it works, but I need to make two modifications:
1. The code copies/pastes all the rows that have that specific id/number in column I on the destination sheet, but it copies the Entire ROW. I need it to only copy from A to P range of the rows that meet the criteria NOT the entire row. This is very important as the row on the sheets may be very long (up to AG column) and in the destination sheet I only want to be pasted the range from A:P
I know I have to change this line: xRRg.EntireRow.Copy, but I have no idea how. do I need to set another range. How?
2. Second problem, I noticed it copies twice some rows, I do not know why and this is not ok, as it messes up the totals I will calculate...
Here is the code I have been working with. Any help will be highly appreciated. Thank you in advance
Public Sub CopyRows_document() Dim xWs As Worksheet Dim xCWs As Worksheet Dim xRg As Range Dim xStrName As String Dim xRRg As Range Dim xC As Integer Dim ans As String On Error Resume Next Application.DisplayAlerts = False xStr = "Document" ans = "0000" Set xCWs = ActiveWorkbook.Worksheets.Item(xStr) If Not xCWs Is Nothing Then xCWs.Delete End If Set xCWs = ActiveWorkbook.Worksheets.Add xCWs.Name = xStr ans = InputBox("Document") xC = 3 For Each xWs In ActiveWorkbook.Worksheets If xWs.Name <> xStr Then Set xRg = xWs.Range("P:P") Set xRg = Intersect(xRg, xWs.UsedRange) For Each xRRg In xRg If xRRg.Value = ans Then xRRg.EntireRow.Copy xCWs.Cells(xC, 1).PasteSpecial xlPasteValuesAndNumberFormats xC = xC + 1 End If Next xRRg End If Next xWs Application.DisplayAlerts = True End Sub