PDA

View Full Version : Copy multiple individual cells



realitybend
07-07-2008, 01:11 PM
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.

:think:

figment
07-07-2008, 03:04 PM
where in this new sheet are you pasting them?

realitybend
07-07-2008, 03:11 PM
The sheet's in a seperate workbook which is already open and set as ActiveWorkbook

figment
07-08-2008, 06:48 AM
from what i can tell you will have to cut and past them one at a time.

some thing like

workbooks("original").worksheets("Sheet1").range("L3").copy workbook("new").worksheet("Sheet1").range("x1")

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
07-08-2008, 09:17 AM
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
07-08-2008, 10:51 AM
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
07-08-2008, 11:05 AM
Have you initialised i?

realitybend
07-08-2008, 11:10 AM
Well, since I don't know what you mean, probably not. :(

mdmackillop
07-08-2008, 11:11 AM
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

mdmackillop
07-08-2008, 11:13 AM
...or maybe the space here, or the missing "s"
Worksheet("Sheet 1")

realitybend
07-08-2008, 11:43 AM
Yes, I had initiallized it. Thanks.

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

mae0429
07-08-2008, 11:56 AM
what error are you getting?

realitybend
07-08-2008, 01:31 PM
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
07-08-2008, 03:18 PM
Can you post the whole of your code?

realitybend
07-09-2008, 10:45 AM
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
07-09-2008, 11:32 AM
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.

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

realitybend
07-09-2008, 11:40 AM
Thanks for your reply. I get a "subscript out of range" here:

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

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

figment
07-09-2008, 11:59 AM
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
07-09-2008, 12:05 PM
"Sheet 1"
See post #10

realitybend
07-09-2008, 12:18 PM
mdmackillop, I see what you said, but I don't understand what's different in mine.:think: Thanks

realitybend
07-09-2008, 12:22 PM
I tried this, and it still says subscript out of range.

Workbooks(Left(File.Name, Len(File.Name) - 4)).Worksheets("Histogram").Range("L3").Copy

mdmackillop
07-09-2008, 12:28 PM
Unless you have changed the standard names, the first sheet is called "Sheet1" not "Sheet 1"

realitybend
07-09-2008, 12:32 PM
I have changed it.

realitybend
07-09-2008, 01:05 PM
When it opens each file, it says that "Some links cannot be updated" even when I use this: UpdateLinks:=xlUpdateLinksNever

Then, whatever I click, it goes to that subscript out of range on this:

Workbooks(Left(File.Name, Len(File.Name) - 4)).Worksheets("Histogram").Range("L3").Copy Workbooks("Money").Worksheets("Sheet 1").Range("E" & I)

mdmackillop
07-09-2008, 01:28 PM
I don't know about the links, buth this works for me (Password disabled)

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")
'Range("A2") should be qualified by a sheet name
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
'Are there only workbooks in the folder?
Workbooks.Open (Folder & "\" & File.Name) ', Password:=PwStr, UpdateLinks:=xlUpdateLinksNever
i = i + 1
Workbooks(File.Name).Worksheets("Histogram").Range("L3").Copy Workbooks("Money.xls").Worksheets("Sheet 1").Range("E" & i)
End If
Next File

Set wb1 = Nothing
End Sub