[VBA] Copy data from Certain Cells In a Sheet with different titles, but layout is the same?


New Member
Hi all,

Wondering if you could help me on this as I'm really not sure where to go.

I am trying to copy data from a Sheet (A Project Charter) into a longform sheet that can then be used to update a tracker.

The cells the Macro will be copying from will always be consistent however the Title of the Project Charter Sheet will likely always be different.

It will likely be copying as follows.

Project Charter SheetLongform Sheet
Cell E3Cell A2
Cell A7Cell B2
Cell M7Cell C2
Cell M9Cell D2
Cell M11Cell E2
Cell M15Cell F2


The above will never change.

Is this possible to run/Create?


Well-known Member
I did not understand.
Do you have several sheets or only 2 sheets?

You need something like this:

Sub test()
  With Sheets("Project Charter")
    .Range("E3").Copy Sheets("Longform").Range("A2")
    .Range("A7").Copy Sheets("Longform").Range("B2")
    .Range("M7").Copy Sheets("Longform").Range("C2")
    .Range("M9").Copy Sheets("Longform").Range("D2")
    .Range("M11").Copy Sheets("Longform").Range("E2")
    .Range("M15").Copy Sheets("Longform").Range("F2")
  End With
End Sub


New Member
Apologies Dante, I really have described this poorly.

I will have two workbook open;

One Workbook is titled "BPE Dashboard" and contains a sheet called Long_Form

One Workbook may have a differing title each time But would always start "Project Charter -"

Then we need to copy the data as above from the sheet "Project Charter" Within the Workbook titled "Project Charter-" into the Workbook "BPE Dashboard", Sheet "Long_Form"

Hope this makes sense?
Last edited:


Well-known Member
Try this

Sub Copy_data()
  Dim wb1 As Workbook, wb2 As Workbook, wb As Workbook
  Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long
  Set wb2 = Workbooks("BPE Dashboard")
  Set sh2 = wb2.Sheets("Long_Form")
  For Each wb In Workbooks
    If LCase(Left(wb.Name, 15)) = LCase("Project Charter") Then
      Set wb1 = wb
      Exit For
    End If
  Set sh1 = wb1.Sheets("Project Charter")
  lr = sh2.Range("A" & Rows.Count).End(xlUp).Row + 1
  sh1.Range("E3").Copy sh2.Range("A" & lr)
  sh1.Range("A7").Copy sh2.Range("B" & lr)
  sh1.Range("M7").Copy sh2.Range("C" & lr)
  sh1.Range("M9").Copy sh2.Range("D" & lr)
  sh1.Range("M11").Copy sh2.Range("E" & lr)
  sh1.Range("M15").Copy sh2.Range("F" & lr)
End Sub

Some videos you may like

This Week's Hot Topics