Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Copying cells from closed workbooks 1

Status
Not open for further replies.

chriscusick

Technical User
Apr 23, 2013
25
0
0
GB
Hi guys,

I am trying to create a VBA that, upon opening the workbook, asks you to select a folder. Once you have selected the relevant folder, it copies certain cells from all excel files in that folder, into the current workbook.

I am not 100% sure if this is possible or if you have to manually select the files you want to copy from?

The cells I would want to copy would be from Cell F24-F27, which would then need to be copied into the new workbook by row instead of column.

Any help with this would be much appreciated. I have had a look through various forums but the closest I can find is some coding that requires you to select 2 files, which isn't much help as it also copied the entire workbook across.

 
hi,

It is not clear what you mean by, "by row instead of column."

Is it ALWAYS "F24-F27" from every workbook in the folder?

Do you mean that you want the VALUE F24 MINUS F27, or do you want the RNAGE F24 to F27?

What does the result look like in the workbook that you open?




Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
My apologies for not being a little clearer on what I meant.

What I need to do is copy cells F24, F25, F26 and F27 from the closed workbooks and paste them into the new workbook in Row A1, B1, C1 and D1. As there will be more than one closed workbook I would be copying from, I need the next set of F24,F25,F26,F27 to be copied into A2, B2, C2, D2. Every set of cells would be copied into the next row down (A3,B3,C3,D3 etc etc until it has copied the cells from all of the workbooks in the folder)

The copied cells are ALWAYS F24,F25,F26,F27.

I hope this clarifies what I am aiming to achieve?



 
well each workbook in the folder must be opend in order to access the data.

So here's what I'd like you to do:

Open your workbook

open one of the workbooks in one of your intended folders.

Turn on your macro recorder.

Open one of the workbooks in one of your intended folders.

COPY F24:F27

select A2 in your target workbook/worksheet and Edit > Paste Special > TRANSPOSE

close the workbook you copied from

Turn off your macro recorder.

Post back with your recorded code.

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Hi Skip,

Below is the macro information you asked for:

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 16/05/2013 by Chris
'

'
Range("F24:F26").Select
Selection.Copy
Windows("Book1").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Windows("Steven Thoma.xml").Activate
ActiveWindow.Close
End Sub

 
Turn on your macro recorder.

Open one of the workbooks in one of your intended folders.
where is the Workbooks.OPEN in your code?

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Hi Skip,

I went through the steps as you listed them but I think the problem was I opened the workbook using the documents folder, instead of opening it through Excel. My mistake. I have re-recorded the macro for you using the open command in excel itself and pasted the code below:

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 16/05/2013 by Chris
'

'
Workbooks.Open Filename:="I:\Work\Wageslips\AnM\05\0510\Steven Thoma.xml"
Selection.Copy
Windows("Book1").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Windows("Steven Thoma.xml").Activate
ActiveWindow.Close
End Sub

Apologies for this oversight.
 
...and one last time WITH the selection range this time (I have no idea why it didnt put it in last time)

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 16/05/2013 by Chris
'

'
Workbooks.Open Filename:="I:\Work\Wageslips\AnM\05\0510\Steven Thoma.xml"
Range("F24:F26").Select
Selection.Copy
Windows("Book1").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Windows("Steven Thoma.xml").Activate
ActiveWindow.Close
End Sub

I'm just going to go bury my head in shame now...excuse me...[sad]
 
COPY this code into a MODULE in your workbook and run...
Code:
Sub Macro1()
    '
    ' Macro1 Macro
    ' Macro recorded 16/05/2013 by Chris
    '
    Dim oFSO As Object, oFile As Object, vPath, ws As Worksheet, lRow As Long
'set activesheet
    Set ws = ActiveSheet
'set the file system object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
'get desired path
    vPath = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
    If vPath <> False Then
        vPath = Left(vPath, InStrRev(vPath, "\") - 1)
    End If
'start pasting at this row
    lRow = 1
'loop thru each excel file in the selected folder
    For Each oFile In oFSO.GetFolder(vPath).Files
    'open the workbook
        With Workbooks.Open(oFile.Path)
        'copy the range
            .ActiveSheet.Range("F24:F26").Copy
        'paste into row
            ws.Cells(lRow, "A").PasteSpecial _
                Paste:=xlPasteValues, _
                Operation:=xlNone, _
                SkipBlanks:=False, _
                Transpose:=True
        'incriment row
            lRow = lRow + 1
        'close the workbook
            .Close
        End With
    Next
'release objects
    Set ws = Nothing
    Set oFSO = Nothing
End Sub

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Thank You Skip you are a star!

I do have one final question though which I am hoping you can help with. I was hoping to figure this one out on my own but it's eluding me...

Is there a way to copy one final cell (C11) and paste this at the start of each row? I have had a little play with the code you have given me but I can't seem to figure out how to add this one cell in.

I know how to move the transposed information across one cell (by changing "ws.Cells(lRow, "A").PasteSpecial _" to "ws.Cells(lRow, "B").PasteSpecial _") this will transpose the copied cells f24:f26 into cell b1 onwards. I just can't seem to figure out how to copy cell C11 into cell A.

Again, thank you so much for your help with this :)
 
I assumed I could use the following lines
.Activesheet.Range("C11").Copy
ws.Cells(1Row, "A").Paste"

before the ".ActiveSheet.Range("F24:F26").Copy"

And edit the line: "ws.Cells(lRow, "A").PasteSpecial _" to "ws.Cells(lRow, "B").PasteSpecial _"

but it didnt work. So I assume I went about this the wrong way?

 

Code:
ws.Cells(1Row, "A").PasteSpecial xlPasteAll

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Where would I paste that to? Or am I overwriting the line ws.Cells(lRow, "A").PasteSpecial _ ?

And is there anything else I need to add so that it copies the right cell?
 
Code:
[b]
        'copy range 1
            .ActiveSheet.Range("C11").Copy
        'paste into row
            ws.Cells(lRow, "A").PasteSpecial xlPasteAll[/b]
        'copy range 2
            .ActiveSheet.Range("F24:F26").Copy
        'paste into row
            ws.Cells(lRow, "B").PasteSpecial _
                Paste:=xlPasteValues, _
                Operation:=xlNone, _
                SkipBlanks:=False, _
                Transpose:=True
        'incriment row
BTW, it is small L -- lRow -- not ONE 1!

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
This would also work
Code:
[b]
        'assign one cell
            ws.Cells(lRow, "A").Value = .ActiveSheet.Range("C11").Value[/b]
        'copy range 2
            .ActiveSheet.Range("F24:F26").Copy
        'paste into row
            ws.Cells(lRow, "B").PasteSpecial _
                Paste:=xlPasteValues, _
                Operation:=xlNone, _
                SkipBlanks:=False, _
                Transpose:=True
        'incriment row

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Ahhh, the ver4 macro. I suppose if your workbooks have open event procedures that you want to prevent from running, that would be a necessitity and you must know the sheet name. Of course, my approach assumes that the workbooks were saved with the right sheet being the active sheet. There are certainly pros & cons to either.

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Skips method works perfectly for what I need, but thanks for the link Paul, I will have a browse at it.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top