Copy multiple individual cells

[realitybend]

How do you copy multiple cells at a time in VBA? I need to copy cells L3, O3, O1, O2, in that order, and paste them in a new sheet. Help is much appreciated.

[figment]

where in this new sheet are you pasting them?

[realitybend]

The sheet's in a seperate workbook which is already open and set as ActiveWorkbook

[figment]

from what i can tell you will have to cut and past them one at a time.

some thing like

[VBA]workbooks("original").worksheets("Sheet1").range("L3").copy workbook("new").worksheet("Sheet1").range("x1")[/VBA]

obviously you need to change the workbook names and sheet names to match what you want, but four calls of that with the right address should get you your desired results.

[mdmackillop]

from what i can tell you will have to cut and past them one at a time.

Agreed,
You can list the addresses in arrays and loop the copy to make it neater.

[realitybend]

I'm trying to open each and copy L3. It doesn't work. What am I missing?

    For Each File In FileList
        If InStr(File.Name, SearchChar) = 0 Then
            Range("A" & i).Value = File.Name
            Workbooks(File.Name).Worksheets("Histogram").Range("L3").Copy Workbook("Money").Worksheet("Sheet 1").Range("E" & i)
            i = i + 1
        End If
    Next File

[mdmackillop]

Have you initialised i?

[realitybend]

Well, since I don't know what you mean, probably not.

[mdmackillop]

[VBA]
i = 1
For Each File In FileList
If InStr(File.Name, SearchChar) = 0 Then
Range("A" & i).Value = File.Name
Workbooks(File.Name).Worksheets("Histogram").Range("L3").Copy Workbook("Money").Worksheet("Sheet 1").Range("E" & i)
i = i + 1
End If
Next File
[/VBA]

[mdmackillop]

...or maybe the space here, or the missing "s"
Worksheet("Sheet 1")

[realitybend]

Yes, I had initiallized it. Thanks.

The other things seem to be correct. Any other ideas?

[mae0429]

what error are you getting?

[realitybend]

Here's what I have so far.

    For Each File In FileList
        If InStr(File.Name, SearchChar) = 0 Then
             wb1.Range("A" & i).Value = File.Name
            Workbooks.Open (Folder & "\" & File.Name), Password:=PwStr, UpdateLinks:=xlUpdateLinksNever
            i = i + 1
            Workbooks(File.Name).Worksheets("Histogram").Range("L3").Copy Workbooks("Money").Worksheets("Kiln 1").Range("E" & i)
        End If
    Next File

It says subscript out of range. This is what I just added:

            Workbooks(File.Name).Worksheets("Histogram").Range("L3").Copy Workbooks("Money").Worksheets("Kiln 1").Range("E" & i)

[mdmackillop]

Can you post the whole of your code?

[realitybend]

Sub Money()
'
' Money Macro
' Keyboard Shortcut: Ctrl+Shift+Q

    Dim fso, Folder, FileList, File
    Dim SearchChar
    Dim PwStr
    Dim wb1 As Worksheet
    
    Set wb1 = ActiveWorkbook.Sheets("Money Chart")

    PwStr = Application.InputBox(Prompt:="Please type in the password; press cancel if none.", Type:=2)
        SearchChar = "Package"
 
    Set fso = CreateObject("Scripting.FileSystemObject")

    Set Folder = fso.GetFolder(Trim(Range("A2").Value))
    Set FileList = Folder.Files
 
    i = 3
  
    For Each File In FileList
 

        If InStr(File.Name, SearchChar) = 0 Then
            '"A" will ensure that the data will start pasting from Column A
            wb1.Range("A" & i).Value = File.Name
            Workbooks.Open (Folder & "\" & File.Name), Password:=PwStr, UpdateLinks:=xlUpdateLinksNever
            i = i + 1
            Workbooks(File.Name).Worksheets("Histogram").Range("L3").Copy Workbooks("Money").Worksheets("Sheet 1").Range("E" & i)
        End If
    Next File
    
Set wb1 = Nothing

End Sub

[figment]

i have made a few changes and added a few comments and questions. my gut reaction is that your opening a workbook that doesn't have a histogram worksheet.

[VBA]Sub Money()
'
' Money Macro
' Keyboard Shortcut: Ctrl+Shift+Q

Dim fso As Object, Folder, FileList, File
Dim SearchChar
Dim PwStr As String
Dim wb1 As Worksheet

Set wb1 = Worksheets("Money Chart")

PwStr = Application.InputBox(Prompt:="Please type in the password; press cancel if none.", Type:=2)
SearchChar = "Package"

Set fso = CreateObject("Scripting.FileSystemObject")
Set Folder = fso.GetFolder(Trim(Range("A2").Value)) 'you should define what sheet this range is coming from
Set FileList = Folder.Files

I = 3

For Each File In FileList
If InStr(File.Name, SearchChar) = 0 Then
'"A" will ensure that the data will start pasting from Column A
wb1.Range("A" & I).Value = File.Name
Workbooks.Open (Folder & "\" & File.Name), Password:=PwStr, UpdateLinks:=xlUpdateLinksNever
I = I + 1 'should this be befor or after the copy?
Workbooks(File.Name).Worksheets("Histogram").Range("L3").Copy Workbooks("Money").Worksheets("Sheet 1").Range("E" & I)
Workbooks(File.Name).Close
End If
Next File

Set wb1 = Nothing

End Sub[/VBA]

[realitybend]

Thanks for your reply. I get a "subscript out of range" here:

[VBA]Workbooks(File.Name).Worksheets("Histogram").Range("L3").Copy Workbooks("Money").Worksheets("Sheet 1").Range("E" & I)[/VBA]

I'm afraid that there is a worksheet called "Histogram".

[figment]

try workbooks(left(file.name,len(file.name)-4) instead of workbooks(File.name)
if your using excel 2008 files then use -5 it might be the .xls in the file name that is messing up the workbooks object.

although it would probably be best to just declare a workbook object and set it equal to when the workbook is opened.

[mdmackillop]

"Sheet 1"
See post #10

[realitybend]

mdmackillop, I see what you said, but I don't understand what's different in mine. Thanks