Excel Macro - Copying data from one workbook to another

[brian003]

Hello everyone,

I have an excel master sheet that is created for every customer filename will change each time, the workbook layout is the same. I would like a macro to import some of the information from the master sheet, I have 3 sheets in the workbook, from each sheet I would need to copy few cell data ex. sheet1 cell F1, sheet2 cell b22, h13, (any range would be fine, i will change that to fit by needs) to a new workbook. I would like the macro button also to move down each time the new data is imported. New Workbook data range paste to A2:D2, next A3:D3 and so on. Below is the code i have so far.

Thank you in advance,



Sub Foo()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet


Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
'-------------------------------------------------------------
'Open file with data to be copied

vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)

'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(1)
End If

'--------------------------------------------------------------
'Copy Range
wsCopyFrom.Range("b5").Copy
wsCopyTo.Range("a2").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False


'Close file that was opened
wbCopyFrom.Close SaveChanges:=False

End Sub

[SamT]

See if this is what you are asking for


'Copy Range
Dim PasteRange As Range
Set PasteRange = CopyTo.Cells(Rows.Count, 1).End(xlUp).Offset(1)
wsCopyFrom.Range("b5").Copy
wsCopyTo.PasteRange.PasteSpecial Paste:=xlPasteValues ', _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

[brian003]

Thanks SamT,
One more thing I need is how to copy more than just one cell and from other sheets like sheet 2 i would need two cells data, sheet 3 four data value.

Thank you for your help.

[SamT]

Set PasteRange = CopyTo.Cells(Rows.Count, 1).End(xlUp).Offset(1)

'Copy Range
With wbCopyFrom
PasteRange = .Sheets("sheet1").Range("b5").Value
PasteRange.Offset(1) = .Sheets("sheet1").Range("C25").Value
PasteRange.Offset(2) = .Sheets("sheet2").Range("D14").Value
PasteRange.Offset(3) = .Sheets("sheet3").Range("X1").Value
End With

[brian003]

Sam, Thanks again.

I'm getting an error, "Run-Time error '424': Object required"

Do you mind to review if i'm missing something.

Thanks in advance.




Set PasteRange = CopyTo.Cells(Rows.Count, 1).End(xlUp).Offset(1)

'Copy Range
With wbCopyFrom
PasteRange = .Sheets("sheet1").Range("b5").Value
PasteRange.Offset(1) = .Sheets("sheet1").Range("C25").Value
PasteRange.Offset(2) = .Sheets("sheet2").Range("D14").Value
PasteRange.Offset(3) = .Sheets("sheet3").Range("X1").Value
End With

[SamT]

where is the rest of your procedure?

[brian003]

Here is all I have so far.




Sub Foo()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Dim PasteRange As Range


Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
'-------------------------------------------------------------
'Open file with data to be copied

vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)

'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(1)
End If

'--------------------------------------------------------------
'Copy Range
Set PasteRange = CopyTo.Cells(Rows.Count, 1).End(xlUp).Offset(1)


With wbCopyFrom
PasteRange = .Sheets("sheet1").Range("b5").Value
PasteRange.Offset(1) = .Sheets("sheet1").Range("C25").Value
PasteRange.Offset(2) = .Sheets("sheet2").Range("D14").Value
PasteRange.Offset(3) = .Sheets("sheet3").Range("X1").Value
End With

'Close file that was opened
wbCopyFrom.Close SaveChanges:=False

End Sub

[SamT]

Set PasteRange = wbCopyTo.Cells(Rows.Count, 1).End(xlUp).Offset(1)

[brian003]

Sam,

Do I need to remove the code of line 'Set wsCopyFrom = wbCopyFrom.Worksheets(1)'
This is the other error i'm receiving now 'Run-time error '438': Object doesn't support this property or method.

Thanks.

[SamT]

Yes, remove it. It is not used. I don't know why it is raising an error.

[brian003]

Can I send you the workbook and see what you can do?

Thanks

[SamT]

Use the "go Advanced" button below the post editor, then on that page scroll down a ways below the post Editor and use the "Manage Attachments" button to upload your Workbook.

[brian003]

Sam,

Please find attached the files.

Thanks.

[SamT]

Are you on a Mac or a windows PC?

[brian003]

Windows PC, Microsoft office 365, Windows 7.

[SamT]

This attachment has two Modules, Module1 is a working version of your code, and Module2 is in my style of coding, Which I feel takes a lot less error prone typing and is much easier to maintain when one of your workbooks changes structure. Right now, the butt is assigned to the Sub in Module2. Notice how I formatted the sheet and "Froze Panes" under Row 1. Now, now matter how low you scroll Row 1 and the button are always visible.

This is my style of coding

Option Explicit

Sub SamT2_PullData()

'''''Source Data Constants
'Job form Sheet
Const DateRng As String = "B4"
Const EstimateIDRng As String = "B3"
Const JobNameRng As String = "H3"
'Propsal Sheet
Const SquareFootageRng As String = "H8"
Const TotalCostRng As String = "B17"
Const DepositRng As String = "B18"
Const BalanceRng As String = "B19"

'''''Target Sheet Variables
Dim DateCol As Range
Dim EstimateIDCol As Range
Dim JobNameCol As Range
Dim SquareFootageCol As Range
Dim TotalCostCol As Range
Dim DepositCol As Range
Dim BalanceCol As Range

Dim vFile As Variant
Dim NR As Long 'Next Empty Row

With ActiveSheet
NR = .Cells(Rows.Count, "A").End(xlUp).Row + 1
Set DateCol = .Range("A:A")
Set EstimateIDCol = .Range("B:B")
Set JobNameCol = .Range("C:C")
Set SquareFootageCol = .Range("D:D")
Set TotalCostCol = .Range("E:E")
Set DepositCol = .Range("F:F")
Set BalanceCol = Range("G:G")
End With

'-------------------------------------------------------------
'Open file with data to be copied

vFile = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*", _
1, "Select Excel File", "Open", False)

'If Cancel then Exit
If vFile = False Then Exit Sub


With Workbooks.Open(vFile)
With .Sheets("JobForm")
DateCol.Cells(NR) = .Range(DateRng).Value
EstimateIDCol.Cells(NR) = .Range(EstimateIDRng).Value
JobNameCol.Cells(NR) = .Range(JobNameRng).Value
End With
With .Sheets("Proposal")
SquareFootageCol.Cells(NR) = .Range(SquareFootageRng).Value
TotalCostCol.Cells(NR) = .Range(TotalCostRng).Value
DepositCol.Cells(NR) = .Range(DepositRng).Value
BalanceCol.Cells(NR) = .Range(BalanceRng).Value
End With

.Close SaveChanges:=False
End With

End Sub
After typing and carefully checking all the Constant declarations, I just Copied and Pasted them and used Ctrl+H to edit as needed. Repeated till the sub was done. I hate typing, I make too many tpyos.

[brian003]

Sam,

I'm really happy that I finally see this working. This will same a lot of time and I no longer have to key in the data from different sheets which is kind of a hard to do. I really appreciate all the help you did in this project. I did review your code which is really easy to understand every action. THANK YOU again!