Mass Data Transfer from Old workbook into New Workbook

[Lynn0713]

Hello,

I have absolutely no training in VBA and have been able to piece together responses from this board previously to achieve my desired result. However, I've run into an issue that is beyond my piecemeal process.

My current workbook has a master data sheet that is a register of the main information from each sheet within the workbook. This workbook did not include all of the required information so I designed a new workbook to include all of the information. I need to copy the data from the old workbook into the new workbook for specific cells in each sheet.

Old Workbook - Contains 277 Sheets for each incident being tracked. Each sheet is named for a person. The "Registry" sheet contains 1 row for each sheet within the workbook.

New Workbook- Contains the 277 sheets for each incident with the same name for each sheet as the old workbook.

I want to transfer the existing data from specific cells in each sheet in the old workbook to the appropriate cell / sheet in the new workbook.

For example:
Old workbook - Sheet name "Lynn" Copy the data from I3 to cell E3 in the new workbook

I'd like it to loop through each sheet, if possible, so I can do this one time and be done with it.

Once the VBA is set up I can finish the code for selecting cells from the old and matching it up with the appropriate cell in the new workbook, I just have no idea how to even start this.

Workbook names:
Old Workbook = Group Accident & Incident Registry
New Workbook = Registry

 

[timfritsch]

Make a copy of both workbooks before running. You will need to change the "Old Workbook" and "New Workbook" names to your actual file names:

Sub test()
  Dim wb1 As String, wb2 As String
  Dim i As Long, j As Long
  
  wb1 = Workbooks("Old Workbook").Name
  wb2 = Workbooks("New Workbook").Name
  
  For i = 1 To Workbooks(wb2).Sheets.Count        'loop through old workbook sheets
    For j = 1 To Workbooks(wb1).Sheets.Count      'search in new workbook for wb2 sheet name
      If Workbooks(wb2).Sheets(i).Name = Workbooks(wb1).Sheets(j).Name Then
        Workbooks(wb2).Sheets(i).Range("I3").Copy Workbooks(wb1).Sheets(j).Range("C3")
        Exit For      'stop the wb1 loop
      End If
    Next j
  Next i
End Sub

Hope this helps.


Tim

 

[Lynn0713]

Tim,

Thank you so much, that works very well. I just have one more question, please.

When I do this it copies the formatting from the old workbook, which I do not want. Is there a way to copy the text only?

Here is what I have

Sub DataTransfer()


Dim wb1 As String, wb2 As String
Dim i As Long, j As Long

wb1 = Workbooks("E Transport Group Accident & Incident Registry").Name
wb2 = Workbooks("Registry New Copy").Name

For i = 1 To Workbooks(wb2).Sheets.Count 'loop through old workbook sheets
For j = 1 To Workbooks(wb1).Sheets.Count 'search in new workbook for wb2 sheet name

If Workbooks(wb2).Sheets(i).Name = Workbooks(wb1).Sheets(j).Name Then

'Copy Truck Number
Workbooks(wb1).Sheets(i).Range("I3").Copy Workbooks(wb2).Sheets(j).Range("D3")
'Trl
Workbooks(wb1).Sheets(i).Range("I4").Text.Copy Workbooks(wb2).Sheets(j).Range("D4")
'Chassis
Workbooks(wb1).Sheets(i).Range("I9").Text.Copy Workbooks(wb2).Sheets(j).Range("D5")
'Commodity
Workbooks(wb1).Sheets(i).Range("I6").Text.Copy Workbooks(wb2).Sheets(j).Range("D6")
'Accident City
Workbooks(wb1).Sheets(i).Range("B5").Text.Copy Workbooks(wb2).Sheets(j).Range("B5")
'Accident State
Workbooks(wb1).Sheets(i).Range("B6").Text.Copy Workbooks(wb2).Sheets(j).Range("B6")
'Injury
Workbooks(wb1).Sheets(i).Range("M2").Text.Copy Workbooks(wb2).Sheets(j).Range("F1")

 

[timfritsch]

Absolutely!

change

Workbooks(wb2).Sheets(i).Range("I3").Copy Workbooks(wb1).Sheets(j).Range("C3")

to

Workbooks(wb2).Sheets(i).Range("I3").Copy 
Workbooks(wb1).Sheets(j).Range("C3"). pasteSpecial paste:=xlPasteValues

That will retain the value and not the formatting.

Happy to help.


Tim