Small Changes to Code

I'm afraid this is a very noobie question, any insight is greatly appreciated. I would like to change this code so that instead of

rng.EntireColumn.Copy

it copies cells 3:1112 of whatever column it is in. Then instead of

Columns(4).Select

I would like it to select cell D4. I just can't get the syntax right to make this happen and I've confused myself into a corner. I know it must be simple.

Here is the code:

Dim rng As Range
    Dim rngSearchX As Range

   Set rngSearchX = Range(Cells(1, 1), Cells(1, Columns.Count).End(xlToLeft))
   For Each rng In rngSearchX.Cells
       If LCase(rng.Value) = "x" Then
            rng.EntireColumn.Copy
            Workbooks.Open ThisWorkbook.Path & Application.PathSeparator & "Purchase Order.xlsm"
            Columns(4).Select
            ActiveSheet.Paste
            ActiveWorkbook.Close True, _
            ThisWorkbook.Path & Application.PathSeparator & "Column" & rng.Column & ".xlsm"
        End If
   Next rng
End Sub

Maybe this:

Dim rng As Range
    Dim rngSearchX As Range

   Set rngSearchX = Range(Cells(1, 1), Cells(1, Columns.Count).End(xlToLeft))
   For Each rng In rngSearchX.Cells
       If LCase(rng.Value) = "x" Then
            Range(Cells(3, rng.Column), Cells(1112, rng.Column)).Copy
            Workbooks.Open ThisWorkbook.Path & Application.PathSeparator & "Purchase Order.xlsm"
            ActiveSheet.Range("D4").Paste
            ActiveWorkbook.Close True, _
            ThisWorkbook.Path & Application.PathSeparator & "Column" & rng.Column & ".xlsm"
        End If
   Next rng
End Sub

Hi Stnkynts,
This is great. The first part is fixed & I see what I was doing wrong, this is a huge help in understanding what I'm doing, thank you. But when I get to line

ActiveSheet.Range("D4").Paste

I get "Runtime error 438: Object doesn't support this property or method". The destination sheet is literally blank cells with nothing to get in the way.

I didn't want to stray from your code too much but when you are accessing multiple workbooks/sheets you really need to reference them by name. It makes sure the code know exactly where to apply what.

It is a little challenging for me to test this code so I hope I didn't forget anything:

Sub asdfsdf()
Dim ws1 As Worksheet:   Set ws1 = ThisWorkbook.Sheets("Sheet1") 'would be best to change ThisWorkbook to be the actual workbook name and sheet name
Dim wb As Workbook
Dim rng As Range, rngSearchX As Range

   Set rngSearchX = ws1.Range(ws1.Cells(1, 1), ws1.Cells(1, Columns.Count).End(xlToLeft))
   For Each rng In rngSearchX.Cells
       If LCase(rng.Value) = "x" Then
            ws1.Range(ws1.Cells(3, rng.Column), ws1.Cells(1112, rng.Column)).Copy
            Workbooks.Open ThisWorkbook.Path & Application.PathSeparator & "Purchase Order.xlsm"
            Set wb = ActiveWorkbook 'acutal workbook name should go here
            wb.Sheets("Sheet1").Range("D4").Paste
            wb.Close True, _
            ThisWorkbook.Path & Application.PathSeparator & "Column" & rng.Column & ".xlsm"
        End If
   Next rng
End Sub

Thanks for getting back to me! I see what you mean & referencing the documents directly & how that will be beneficial. Thank you! I'm trying to figure that out. I keep getting "Compile error: Syntax Error" when I try it. It gets stuck at the Set ws1 point.

Updated based on your last post, I pasted the code below & I also attached the files I am working with. The macro I'm trying to run is in the Cost Template named "Create_PO". Thanks for your patience with me! I am learning a ton from this forum and nice people like you.

Dim ws1 As Worksheet
Set ws1 = Cost Template 2014.Sheets("Detail") 'would be best to change ThisWorkbook to be the actual workbook name and sheet name
Dim wb As Workbook
Dim rng As Range, rngSearchX As Range

   Set rngSearchX = ws1.Range(ws1.Cells(1, 1), ws1.Cells(1, Columns.Count).End(xlToLeft))
   For Each rng In rngSearchX.Cells
       If LCase(rng.Value) = "x" Then
            ws1.Range(ws1.Cells(3, rng.Column), ws1.Cells(1112, rng.Column)).Copy
            Workbooks.Open ThisWorkbook.Path & Application.PathSeparator & "Purchase Order.xlsm"
            Set wb = Purchase Order 'acutal workbook name should go here
            wb.Sheets("Detail").Range("D4").Paste
            wb.Close True, _
            ThisWorkbook.Path & Application.PathSeparator & "Column" & rng.Column & ".xlsm"
        End If
   Next rng

The reason you got the syntax error is because when defining a workbook you need to include some language. :

Sub asdfsdf()

Dim ws1 As Worksheet
Set ws1 = Workbooks("Cost Template 2014.xlsm").Sheets("Detail") 'would be best to change ThisWorkbook to be the actual workbook name and sheet name
Dim wb As Workbook
Dim rng As Range, rngSearchX As Range

   Set rngSearchX = ws1.Range(ws1.Cells(1, 1), ws1.Cells(1, Columns.Count).End(xlToLeft))
   For Each rng In rngSearchX.Cells
       If LCase(rng.Value) = "x" Then
            ws1.Range(ws1.Cells(3, rng.Column), ws1.Cells(1112, rng.Column)).Copy
            Workbooks.Open ThisWorkbook.Path & Application.PathSeparator & "Purchase Order.xlsm"
            Set wb = Workbooks("Purchase Order.xlsm") 'acutal workbook name should go here
            wb.Sheets("Detail").Range("D4").Paste
            wb.Close True, _
            ThisWorkbook.Path & Application.PathSeparator & "Column" & rng.Column & ".xlsm"
        End If
   Next rng

End Sub

In addition, I was not able to open your attached Cost Template 2014 file. I would verify that you attached the correct and working version and resubmit.

Either way I updated your code. I may have missed something (It's getting late and my eyes are tired). If it errors on you let me know.

Thank you Stnkynts. I see what you changed & it makes sense now. I will try this today. I was having a lot of trouble getting the Cost Template to upload because it was .xltm. I had to change it to .xlsm in order to upload it. I will try my best with this new code first before bothering you with a new upload. Thank you for making your eyes red and tired looking at my stuff. I am extremely grateful!