VBA how to Copy specific range instead of Entire.Row ( i nned to modify code)

Clairexcel

New Member
Joined
Mar 23, 2021
Messages
31
Office Version
  1. 2016
  2. 2010
Hello everyone,
I have been working on a new project and so far I managed to create userforms to add, edit, I am pretty satisfied )
However I am stuck with another vba code: I made it loop only into the used range of the source sheet and copy/paste into the destination sheet only the rows that contain the specific ans (the specific id number) that exists in column I in the source sheet.
It works perfectly but I need to make two adjustments:
1. I want this code to copy/paste only specific cells into the destination sheet and not the entire row. For example I want it to find it to find the rows containing the ans number and the copy/paste into the destination sheet only the cells A, B, C, H and P of those rows, not the entire row. So this is the line I should modify nut I do not know how:
xRRg.EntireRow.Copy
It is driving me nuts, but I do not know how to tell him to only copy cells A, B, C ,H and P (for example) in the destination sheet.

2. Every time I run the code, formating of the destination sheet goes lost. It is not a big issue, but I would like for the destination sheet to preserve format I gave it...if possible.
Now the macro command button for this code is in the home page (so not on the destination sheet nor on the source sheet.
Any help would be highly apreciated guys, so thank you in advance.
Here is the vba code I put together
VBA Code:
Public Sub CopyRows_BOLLA()
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 = "BOLLA"
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("Bolla")
xC = 3
For Each xWs In ActiveWorkbook.Worksheets
If xWs.Name <> xStr Then
Set xRg = xWs.Range("I:I")
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

Hope you can help me, thanks
 
Last edited:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
60,181
Office Version
  1. 365
Platform
  1. Windows
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Vba - copy specific range and NOT entire row - OzGrid Free Excel/VBA Help Forum
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 

Clairexcel

New Member
Joined
Mar 23, 2021
Messages
31
Office Version
  1. 2016
  2. 2010
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Vba - copy specific range and NOT entire row - OzGrid Free Excel/VBA Help Forum
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
@Fluff ok, had no idea, well noted now. Sorry for any inconvenience I may have caused.
 

Forum statistics

Threads
1,136,845
Messages
5,678,101
Members
419,742
Latest member
Dropzyl88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top