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 A22, next A33 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!