Copy several columns to a new workbook in a different order\location - VBA

[Evapar18]

I have been searching most of this morning looking for a solution. I have not seen anything like what I am wanting to do.

I have a Bill Of Materials with a part number, Description, Cost, and QTY. Some of those rows do not list an item, so I don't want those copied. Just the cells that have a value in the QTY column.

Once copied I need to open another quoting spreadsheet and place the copied items. Needless to say, the items in the quote spreadsheet are not in the order as my BOM.

I did find some information to copy a column to a new workbook. So I tried to start out with the basics but while trying out these tips for coping columns to an existing spreadsheet I have had nothing but bad luck. Instead of just opening the existing workbook, it opens a new workbook and stops with a message "method range of object _global failed". So I know the code I have been trying to use is seriously flawed.

Private Sub CommandButton4_Click()Dim partNum As Double
Dim Descrp As String
Dim cost As Currency
Dim qty As Single
Dim qdata As Workbook


Worksheets("Positech").Select

Worksheets("Positech").Copy
partNum = Range("AM7:AM24")
Descrp = Range("AN7:AN24")
cost = Range("AP7:AP24")
qty = Range("AQ7:AQ24")


Workbooks.Open Filename:=("C:\Users\scott.baugh\Desktop\Blank Quote.xls")
Worksheets("sheet1").Select


Worksheets("sheet1").Range("A24") = qty
Worksheets("sheet1").Range("B24") = partNum
Worksheets("sheet1").Range("E24") = Descrp
Worksheets("sheet1").Range("N24") = cost




End Sub

I know this would probably select the whole column, but I am just trying to get it to work before I start adding further complication to not copy the values where there is no "-" QTY.

I hope this all makes sense.

EP

 

[mumps]

I'm not sure if I understood correctly but try this macro:

Private Sub CommandButton4_Click()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet
    Set srcWS = ThisWorkbook.Sheets("Positech")
    srcWS.Range("AQ6:AQ24").AutoFilter Field:=1, Criteria1:="<>"
    Workbooks.Open Filename:=("C:\Users\scott.baugh\Desktop\Blank Quote.xls")
    Set desWS = Sheets("sheet1")
    srcWS.Range("AQ7:AQ24").SpecialCells(xlCellTypeVisible).Copy desWS.Range("A24")
    srcWS.Range("AM7:AM24").SpecialCells(xlCellTypeVisible).Copy desWS.Range("B24")
    srcWS.Range("AN7:AN24").SpecialCells(xlCellTypeVisible).Copy desWS.Range("E24")
    srcWS.Range("AP7:AP24").SpecialCells(xlCellTypeVisible).Copy desWS.Range("N24")
    srcWS.Range("AQ6").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[Evapar18]

Thanks for your reply. That sorta worked... and I don't know how else to explain it at the moment.

Here is the BOM:
https://drive.google.com/file/d/1uKPN2qlLsYfqvfA2m0dpmhrcwkfshwES/view?usp=sharing

Here is the Quote:
https://drive.google.com/file/d/1hZIquX3TXT0vLVHTALTu_oTEmTZKQitt/view?usp=sharing

I can't have the "-" in the BOM pasted into the quote. The other issue is the BOM is always different. So I don't have a set of cells that the BOM will always be in. The list could be longer or shorter. Otherwise, I would name columns.

So I need to take what is in the Positech worksheet (BOM) and paste it into the corresponding rows in the quote sheet... does that help?

 

[Evapar18]

Also, the items that are being copied need to be pasted as values, because the BOM is a series of equation values. I did try and change your code but "Value" is not an option for Cell type.

When I read the code from my basic minded eyes, it looks like it reads backwards too me.

 

[mumps]

I need further clarification on the following:

-I can't have the "-" in the BOM pasted into the quote
-The other issue is the BOM is always different. So I don't have a set of cells that the BOM will always be in.
-corresponding rows in the quote sheet

Perhaps the best way for me to visualize what you want to do, is for you to do a manual mock-up of the expected results in the Quote sheet. Also, it would be easier to test possible solutions if you could upload copies of the actuals file instead of pictures.

 

[Evapar18]

I made some examples since I cannot send out the protected company files.

BOM Example: FYI - This example is just value's not formula's like the original file has.
https://drive.google.com/open?id=1ogMoKBslvQJD7zM0Q3TBdaaT8W7yet4C

Quote Example: This shows the finished design
https://drive.google.com/open?id=1Y6eCE0gqhu8KNcB9A-S10V3uJTZu70Qw

I went back through the code and I saw kind of what the problem was. It was simply in the wrong columns I changed that and values are going into the correct spots now, it's just coming over with the formulas built in.

Seen here:
https://drive.google.com/open?id=1Rf06ypHeXoFqHmIe5yfT0ufcOUx_SCLZ
Row 24 in the image above is very confusing since that is not in the BOM example.

Thank you for all your help and patience, very much appreciated!

 

[mumps]

Try:

Private Sub CommandButton4_Click()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet
    Set srcWS = ThisWorkbook.Sheets("Positech")
    srcWS.Range("AQ6:AQ24").AutoFilter Field:=1, Criteria1:="<>"
    srcWS.Range("AL5:AQ24").AutoFilter Field:=6, Criteria1:="<>-"
    srcWS.Range("AL5:AQ24").AutoFilter Field:=5, Criteria1:="<>-"
    Workbooks.Open Filename:=("C:\Users\scott.baugh\Desktop\Blank Quote.xls")
    Set desWS = Sheets("sheet1")
    srcWS.Range("AQ6:AQ24").SpecialCells(xlCellTypeVisible).Copy
    desWS.Range("A21").PasteSpecial xlPasteValues
    srcWS.Range("AM6:AM24").SpecialCells(xlCellTypeVisible).Copy
    desWS.Range("B21").PasteSpecial xlPasteValues
    srcWS.Range("AN6:AN24").SpecialCells(xlCellTypeVisible).Copy
    desWS.Range("C21").PasteSpecial xlPasteValues
    srcWS.Range("AP6:AP24").SpecialCells(xlCellTypeVisible).Copy
    desWS.Range("D21").PasteSpecial xlPasteValues
    srcWS.Range("AL5").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[Evapar18]

That gives me an error:

Run-Time Error '1004':
AutoFilter Method of Range class failed

Debug stops at this line:
srcWS.Range("AL5:AQ24").AutoFilter Field:=6, Criteria1:="<>-"

 

[mumps]

When I tested the macro on the files you uploaded it worked properly. Are you testing the macro on a different file? If so, that may be the problem. What works on a sample file most often will not work on the actual file. Perhaps you can upload copies of your actual files, de-sensitized.

 

[Evapar18]

Yes, I did. I placed the code into the sheets that I could not send to you. But the sheets I did send to you I used all the same cell locations. I did have to change the range to AQ7 and AL7 because I didn't need the first two rows. I tested the code just how you had it and with the changes I made and I get the same error. I cannot get past that point in the code and I don't understand what that error actually means?

I opened up the files I sent you and tested the code in there and got the same error.