How to copy specific cells and paste to a new workbook

Question

Sub Button3_Click()

'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xlsx"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)
    Set newWb = Workbooks.Add
    With newWb
        .SaveAs Filename:=myPath & Left(myFile, 5) & "_import.xlsx"
    End With
'Loop through each Excel file in folder
  i = 2
  Do While myFile <> ""

    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
      Set newWb = Workbooks.Open(Filename:=myPath & Left(myFile, 5) & "_import.xlsx")
    'Change First Worksheet's Background Fill Blue
      wb.Sheets("Textual elements").Range("J11").Copy _
      Destination:=newWb.Sheets("Sheet1").Cells(i, 1)
      wb.Worksheets("Textual elements").Range("J31").Copy _
      Destination:=newWb.Worksheets("Sheet1").Cells(i, 2)

    i = i + 1

    'Save and Close Workbook
      newWb.Close SaveChanges:=True
    'Get next file name
      myFile = Dir()
  Loop
'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

So I took the code from below site tried to edit according to my needs, but I get error italicized row in debugging mode.

The intention is to open a new workbook named as selected the folder and copy the cells to specific cells.

http://www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given-folder

Answer 1

I am still using Excel2002 so it doesn't play nice with xlsx files all the time. That said, you may not need the line

set newWb = Workbooks.Open(Filename:=myPath & Left(myFile, 5) & "_import.xlsx")

as I believe the workbook should open when it is added (possibly different in new versions).

When it comes to copying the range from one workbook to another

wb.Worksheets("Textual elements").Range("J11").Copy Destination:=newWb.Worksheets("Sheet1").Range(Cells(i, 1))

I am not sure if you have the Do While myFile <> "" loops set properly. You are ensuring myFile <> "" then doing something but not changing myFile's value and checking again that myFile <> ""

Also if you run this macro, it will overwrite the specified cells each time it is run so you will only have the most recent data - just incase that's not what you're trying to do.

EDIT
I still don't think you need to open the newwb when you have just opened it - might be best to step through the code using F8 & F9 to test that.

With regards the copying, I was right that you should use copy : destination, but hadn't noticed you were trying to range a cell. It should be either Range() OR cell(). Try this:

  wb.Sheets("Textual elements").Range("J11").Copy _
    Destination:=newWb.Sheets("Sheet1").Cells(i, 1)
  wb.Worksheets("Textual elements").Range("J31").Copy _
    Destination:=newWb.Worksheets("Sheet1").Cells(i, 2)

The space underscore ' _' at the end of copy is just to take the codee to a new line for ease of reading (so it doesn't go off the end of the page)

At the end of your code you are closing wb and saving changes even though you have not made any changes. I would change this to newwb and close wb without saving changes.

Answer 2

The Range-object does not have a Paste method, so it cannot identify the Paste statement. Hence the error. You can use PasteSpecial though.

Try this:

replace:

  wb.Worksheets("Textual elements").Range("J11").Copy
  newWb.Worksheets("Sheet1").Range(Cells(i, 1)).Paste
  wb.Worksheets("Textual elements").Range("J11").Copy
  newWb.Worksheets("Sheet1").Range(Cells(i, 2)).Paste

with:

 wb.Worksheets("Textual elements").Range("J11").Copy
 newWb.Worksheets("Sheet1").Range(Cells(i, 1),Cells(i,2)).PasteSpecial

or without PasteSpecial:

 wb.Worksheets("Textual elements").Range("J11").Copy newWb.Worksheets("Sheet1").Range(Cells(i, 1),Cells(i,2))  

or even, if you must use Paste ;-):

 wb.Worksheets("Textual elements").Range("J11").Copy
 newWb.Worksheets("Sheet1").Range(Cells(i, 1),Cells(i,2)).select
 ActiveSheet.Paste