PDA

View Full Version : [SOLVED] Copy from one workbook then paste into one other



Nicolaf
08-20-2013, 05:09 AM
Hi,

I have done a macro to look for a cell in a worksheet and copy paste it into another worksheet of a different workbook.

Code below:


Private Sub CommandButton1_Click()

IName = ThisWorkbook.Sheets("List").Range("B7").Value 'name with extension
Set NewWkbk = Workbooks.Open(Filename:="P:\Lonib\" & IName)
SName = ThisWorkbook.Sheets("List").Range("A7").Value 'sheet name
NewWkbk.Sheets(SName).Select
Windows(IName).Activate
ActiveSheet.Calculate
ActiveSheet.Range("M6").Select
Selection.Copy
Windows("Fixings.xls").Activate
Sheets("List").Range("C7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(IName).Activate
ActiveWindow.Close

IName = ThisWorkbook.Sheets("List").Range("B8").Value 'name with extension
Set NewWkbk = Workbooks.Open(Filename:="P:\Lonib\" & IName)
SName = ThisWorkbook.Sheets("List").Range("A8").Value 'sheet name
NewWkbk.Sheets(SName).Select
Windows(IName).Activate
ActiveSheet.Calculate
ActiveSheet.Range("M6").Select
Selection.Copy
Windows("Fixings.xls").Activate
Sheets("List").Range("C8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(IName).Activate
ActiveWindow.Close

End Sub


So in file Fixings.xls in worksheet List we have the workbook to open (file name is in cell B7).
The worksheet to open is found in worksheet List in cell A7.
Once cell M6 has been copied then we move to next workbook found in cell B8 and next worksheet found in cell A8.

What I would like to do is a loop so that instead of repeating code for cell B7/A7, B8/A8 etc. it simply does this automatically for all data found in columns A and B of Fixings.xls until no more data is found and macro stops.

How can I do this?

Let me know if something not clear.

Thanks,
Nix

:dunno

SamT
08-20-2013, 08:16 AM
This code is just your recorded macro with all not needed stuff taken out to make it proper. Please study it carefully to understand what I did. You should do the same with any macro you record.
Private Sub Clean_CommandButton1_Click()

'With B7 only
Iname = ThisWorkbook.Sheets("List").Range("B7").Value 'name with extension
Set NewWkBk = Workbooks.Open(Filename:="P:\Lonib\" & Iname)
SName = ThisWorkbook.Sheets("List").Range("A7").Value 'sheet name

Workbooks(Iname).Range("M6").Copy
Workbooks("Fixings.xls").Sheets("List").Range("C7").PasteSpecial _
Paste:=xlPasteValues
Workbooks(Iname).Close

End Sub


This code should solve your issue and run through the entire list of workbooks.

Private Sub New_CommandButton1_Click()

Dim List As Worksheet
Dim BkList As Range
Dim ShtList As Range
Dim FixList As Range
Dim LastRow As Long
Dim Iname As String
Dim SName As String
Dim NewWkBk As Workbook

Dim cel As Long

Set List = ThisWorkbook.Sheets("List")
With List
LastRow = .Range("B7").End(xlDown).Row
Set BkList = .Range("B7:B" & LastRow)
Set ShtList = .Range("A7:A" & LastRow)
End With

Set FixList = Workbooks("Fixings.xls").Sheets("List").Range("C7:C" & LastRow)

For cel = 1 To BkList.Count

Iname = BkList.Cells(cel).Value 'name with extension
On Error GoTo celnext 'In case book is not exist
Set NewWkBk = Workbooks.Open(Filename:="P:\Lonib\" & Iname)
On Error GoTo 0 'stop error checking
SName = ShtList.Cells(cel).Value 'sheet name

Workbooks(Iname).Sheets(SName).Range("M6").Copy
FixList.Cells(cel).PasteSpecial Paste:=xlPasteValues
Workbooks(Iname).Close

celnext:
Next cel

End Sub



Is "ThisWorkbook" the same book as "Fixings.xls"? If so, move the "Set FixList" line inside the "With List" section like this
With List
LastRow = .Range("B7").End(xlDown).Row
Set BkList = .Range("B7:B" & LastRow)
Set ShtList = .Range("A7:A" & LastRow)
Set FixList = .Range("C7:C" & LastRow)
End With

Nicolaf
08-21-2013, 07:58 AM
Great that works really well!

One last feature please.

How would I amend your code to also refresh the worksheet which has been opened (so SName) and then close workbook (Iname) without saving?


I thought simply putting




ActiveSheet.Calculate


and



Workbooks(Iname).Close savechanges:=False


Would work but it does not.

Thanks,
Nix

SamT
08-21-2013, 09:28 AM
Nothing on SName has changed, but if you want

Workbooks(Iname).Sheets(SName).Range("M6").Copy
FixList.Cells(cel).PasteSpecial Paste:=xlPasteValues

Workbooks(Iname).Sheets(SName).Calculate
Workbooks(Iname).Saved = True

Workbooks(Iname).Close

celnext:
Next cel

Nicolaf
08-21-2013, 09:42 AM
Perfect thanks a lot!

Nix
Ps. In fact when you refresh worksheet SName if there is a formula then a value (in this case in M6) will change

:hi::hi::hi: