Copy and paste macro can’t remove formatting.

[Geosphere]

Hello,


I’m very new to excel macro's

What I am trying to do is take Info from a BOM with Reference, Value and Part numbers from sheet1 and move the data into sheet2 that I can then use to print a sticker.

when I run my macro it opens a search box, I search for a unique part value then it will copy and paste 3 cells from the same row to a sheet2 A1,A2,A3 and then move them in a way, so I am able to print them to a sticker.
I have found some random bits of code scattered around the web that dose 90% of what I want but I can’t seem the last few bits to work, and I hope someone could help me out.

I would like to remove the formatting when it copies the data, I have tried some of the paste special options, but they never work.

I guess my only other way I could make it work is so it formats sheet when I has finished the copy?

If anyone could point me in the right direction it would really help me out.



Thanks

Sub customcopy()

Dim strsearch As String
Dim lastline As Integer
Dim tocopy As Integer

ActiveWorkbook.Worksheets("Sheet1").Select
strsearch = CStr(InputBox("enter the string to search for"))
lastline = Range("A65536").End(xlUp).Row
j = 1

For i = 1 To lastline
    For Each c In Range("A" & i & ":Z" & i)
        If c.Text = strsearch Then
            tocopy = 1
        End If
    Next c
    If tocopy = 1 Then
           Range(Cells(i, "A"), Cells(i, "C")).Copy Destination:=Sheets("Sheet2").Cells(j, "A")
        
          
        j = j + 1
    End If
tocopy = 0
Next i

ActiveWorkbook.Worksheets("Sheet2").Select
 Range("A1").Cut Destination:=Range("B3")
 Range("B1").Cut Destination:=Range("B4")
 Range("C1").Cut Destination:=Range("B5")
 


End Sub

 

[vcoolio]

Hello Geosphere

Copy/pasting of the cell values only will work. Change this line:

Range(Cells(i, "A"), Cells(i, "C")).Copy Destination:=Sheets("Sheet2").Cells(j, "A")

to

Range(Cells(i, "A"), Cells(i, "C")).Copy
Sheets("Sheet2").Cells(j, "A").PasteSpecial xlValues

It needs to be on two lines as shown.
It will copy /paste cell values only, nothing else.

I hope that this helps.

Cheerio,
vcoolio.

 

[dave3009]

You can simply set the destination value to the source value thus reducing the number of steps.

Try the following:

Sub customcopy_alt()

Dim strSearch As String
Dim lstLine As Integer, i As Integer
Dim srcSh As Worksheet, dstSh As Worksheet
Dim Found As Range

Set srcSh = Worksheets("Sheet1")
Set dstSh = Worksheets("Sheet2")

strSearch = CStr(InputBox("enter the string to search for"))
lstLine = Range("A" & Rows.Count).End(xlUp).Row

j = 1

For i = 1 To lstLine
    Set Found = srcSh.Range("A" & i).Resize(, 26).Find(strSearch)
    If Not Found Is Nothing Then
        dstSh.Range("A" & j).Resize(, 3).Value = srcSh.Range("A" & i).Resize(, 3).Value
        j = j + 1
    End If
Next i

'========================================
' not sure what the purpose of this section is!!?
'========================================

'ActiveWorkbook.Worksheets("Sheet2").Select
' Range("A1").Cut Destination:=Range("B3")
' Range("B1").Cut Destination:=Range("B4")
' Range("C1").Cut Destination:=Range("B5")
 
End Sub

 

[Geosphere]

Thanks Dave your code strips the formatting perfect, but it only seems to work if I run the macro when in Sheet1.


The code at the bottom moves it into separated rows as below

Locations:	R1, R3, R4, R5, R6, R8, R10, R14, R15, R16
Value:	10K 1% 0805
MF Part number:	WCR0805-10KFI

 

[dave3009]

Hi @Geosphere , sorry this variable needs to be set with explicit sheet reference:

lstLine = srcSh.Range("A" & Rows.Count).End(xlUp).Row

What would be much better is to use the sheet codenames, thereby removing the need to declare and set the variables. Preferable use relevant names, but for demonstration purposes I've stuck with srcSh and dstSh.

Sub customcopy_alt()

Dim strSearch As String
Dim lstLine As Integer, i As Integer
Dim Found As Range

strSearch = CStr(InputBox("enter the string to search for"))
lstLine = srcSh.Range("A" & Rows.Count).End(xlUp).Row

j = 1

For i = 1 To lstLine
    Set Found = srcSh.Range("A" & i).Resize(, 26).Find(strSearch)
    If Not Found Is Nothing Then
        dstSh.Range("A" & j).Resize(, 3).Value = srcSh.Range("A" & i).Resize(, 3).Value
        j = j + 1
    End If
Next i

'========================================
' not sure what the purpose of this section is!!?
'========================================

'With dstSh
' .Range("A1").Cut Destination:=.Range("B3")
' .Range("B1").Cut Destination:=.Range("B4")
' .Range("C1").Cut Destination:=.Range("B5")
'End With
End Sub