Using a Named Range in VBA to Copy & Paste in Next Blank Column

[Kristylee0228]

Hi All -
I am looking to find how to use the Named Range to Copy and Paste from one document to another using VBA Code.
My macro currently uses a range to find the last blank cell in a row, but I can't figure out how to use that code in a different column.
The Macro opens "MyFile" and copies "D2". Then opens "RPCCalls_Count" and pastes into "B2". The ActiveSheet.Range("aRPCLastCell") finds the next blank row in Column B.
I would like another named range to jump over to Column C.
What the entire Macro is to do is copy Cell References from "MyFile" D2, D3, D4, D5 and F2, F3, F4, F5 and H2:H4 and Paste them into a new File named "RPCCalls_Count", Row 2.
Cells B through J. Column A is written text as the name of the Tab, "RPC Call 1", etc...
"MyFile" has 5 tabs named "RPC Call 1", "RPC Call 2" etc.. through "Call 5".
There's a loop to run through all the files within "MyFolder".
Any help to make this code easier would be greatly appreciated. As I am somewhat knowledgeable in VBA Code, but not much.

Here's the example code I have:
Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
Sheets("RPC Call 1").Select
Range("D2").Select
Selection.Copy
Workbooks.Open Filename:="\\ncbanalytics\Automation\Kristy\RPCCalls_Count.xlsx"
Sheets("CallCount").Select
Range("B2").Select
ActiveSheet.Range("aRPCLastCell").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A6").Select
Application.CutCopyMode = False
Workbooks(MyFile).Close SaveChanges:=False
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

Thank You -
Kristy

 

[HaHoBe]

Hi Krity,

you could use an offset to the named range in a loop. Your description has been clear about the cells to copy but not about if all sheets are to be processed or how you decide which sheet in the workbook to proced.

The following sniplet will get the first free cell for each column in the target sheet like

Sub MrE1222163()
'https://www.mrexcel.com/board/threads/using-a-named-range-in-vba-to-copy-paste-in-next-blank-column.1222163/
Dim wbToOpen As Workbook
Dim wbCallsCount As Workbook
Dim wsToPaste As Worksheet
Dim wsData As Worksheet
Dim varCells As Variant
Dim lngArr As Long
Dim lngFree As Long
Dim myFile As String

varCells = Array("D2", "D3", "D4", "D5", "F2", "F3", "F4", "F5", "H2", "H3", "H4")
'....

'...
Do While myFile <> ""
  Set wbToOpen = Workbooks.Open(Filename:=myFolder & "\" & myFile, UpdateLinks:=False)
  Set wsData = wbToOpen.Sheets("RPC Call 1")
  If wbCallsCount Is Nothing Then
    Set wbCallsCount = Workbooks.Open(Filename:="\\ncbanalytics\Automation\Kristy\RPCCalls_Count.xlsx")
  End If
  Set wsToPaste = wbCallsCount.Sheets("CallCount")
  For lngArr = LBound(varCells) To UBound(varCells)
    With wsToPaste
      lngFree = .Cells(.Rows.Count, 2 + lngArr).End(xlUp).Row + 1
      .Cells(lngFree, 2 + lngArr).Value = wsData.Range(varCells(lngArr)).Value
    End With
  Next lngArr
  wbToOpen.Close SaveChanges:=False
  myFile = Dir
Loop

Set wsData = Nothing
Set wbToOpen = Nothing
Set wsToPaste = Nothing
Set wbCallsCount = Nothing

Application.ScreenUpdating = True
End Sub

Ciao,
Holger

 

[Kristylee0228]

Hi Krity,

you could use an offset to the named range in a loop. Your description has been clear about the cells to copy but not about if all sheets are to be processed or how you decide which sheet in the workbook to proced.

The following sniplet will get the first free cell for each column in the target sheet like

Sub MrE1222163()
'https://www.mrexcel.com/board/threads/using-a-named-range-in-vba-to-copy-paste-in-next-blank-column.1222163/
Dim wbToOpen As Workbook
Dim wbCallsCount As Workbook
Dim wsToPaste As Worksheet
Dim wsData As Worksheet
Dim varCells As Variant
Dim lngArr As Long
Dim lngFree As Long
Dim myFile As String

varCells = Array("D2", "D3", "D4", "D5", "F2", "F3", "F4", "F5", "H2", "H3", "H4")
'....

'...
Do While myFile <> ""
  Set wbToOpen = Workbooks.Open(Filename:=myFolder & "\" & myFile, UpdateLinks:=False)
  Set wsData = wbToOpen.Sheets("RPC Call 1")
  If wbCallsCount Is Nothing Then
    Set wbCallsCount = Workbooks.Open(Filename:="\\ncbanalytics\Automation\Kristy\RPCCalls_Count.xlsx")
  End If
  Set wsToPaste = wbCallsCount.Sheets("CallCount")
  For lngArr = LBound(varCells) To UBound(varCells)
    With wsToPaste
      lngFree = .Cells(.Rows.Count, 2 + lngArr).End(xlUp).Row + 1
      .Cells(lngFree, 2 + lngArr).Value = wsData.Range(varCells(lngArr)).Value
    End With
  Next lngArr
  wbToOpen.Close SaveChanges:=False
  myFile = Dir
Loop

Set wsData = Nothing
Set wbToOpen = Nothing
Set wsToPaste = Nothing
Set wbCallsCount = Nothing

Application.ScreenUpdating = True
End Sub

Ciao,
Holger

Thank you for your reply, Holger.
I apologize for not being clear on the results. Yes. All 5 tabs in the WorkBook need to be processed.
The Macro starts on "MyFile", RPC Call 1 tab, copies the cells, D2, D3, D4, D5 and F2, F3, F4, F5 and H2:H4 and then Pastes those cells into the first blank row of RPCCalls_Count.xlsx file. Next would be RPC Call 2 tab, RPC Call 3 tab, RPC Call 4 tab then RPC Call 5.
The same exact cells are copied from each tab, but in the next consecutive row.
When RPC Call 5 is complete, the Macro closes that file and runs the loop to do the same thing on ALL files within "MyFolder."

I hope this is more clear. Please let me know if there's anything else you need to assist me.
I thank you so very much!!

 

[HaHoBe]

Hi Kristy,

due to your information the proceeding of all 5 sheets is included in code as well as some checks for opened workbooks or available sheets. I have not been able to test the code on any live data but should have included enough checks (hopefully).

Sub MrE1222163_V2()
'https://www.mrexcel.com/board/threads/using-a-named-range-in-vba-to-copy-paste-in-next-blank-column.1222163/
Dim lngArr            As Long
Dim lngFree           As Long
Dim lngSh             As Long

Dim myFile            As String
Dim myFolder          As String

Dim varCells          As Variant
Dim varSheets         As Variant

Dim wbToOpen          As Workbook
Dim wbCallsCount      As Workbook

Dim wsToPaste         As Worksheet
Dim wsData            As Worksheet


'array holding the cell addresses to proceed
varCells = Array("D2", "D3", "D4", "D5", "F2", "F3", "F4", "F5", "H2", "H3", "H4")
'array holdung the sheet names in the opened workbook
varSheets = Array("RPC Call 1", "RPC Call 2", "RPC Call 3", "RPC Call 4", "RPC Call 5")

'....

'...
Do While myFile <> ""
  'only open collector workbook once
  If wbCallsCount Is Nothing Then
    On Error Resume Next
    Set wbCallsCount = Workbooks.Open(Filename:="\\ncbanalytics\Automation\Kristy\RPCCalls_Count.xlsx")
    If wbCallsCount Is Nothing Then
      MsgBox "Check path and name of collecting workbook 'RPCCalls_Count.xlsx'.", vbInformation, "Ending here"
      Err.Clear
      GoTo end_here
    End If
    On Error GoTo 0
  End If
  If Evaluate("ISREF('" & "CallCount" & "'!A1)") Then
    Set wsToPaste = wbCallsCount.Sheets("CallCount")
  Else
    MsgBox "Can*t find Sheet 'CallCount' in Workbook", vbInformation, "Ending here"
    GoTo end_here
  End If
  
  On Error Resume Next
  Set wbToOpen = Workbooks.Open(Filename:=myFolder & "\" & myFile, UpdateLinks:=False)
  If wbToOpen Is Nothing Then
    If MsgBox("Problems opening workbook '" & wbToOpen.Name & "." & vbCrLf & _
        "Continue with next workbook or exit?", vbInformation, vbOKCancel) = vbCancel Then
      Err.Clear
      On Error GoTo 0
      GoTo end_here
    Else
      Err.Clear
      On Error GoTo 0
      GoTo next_file
    End If
  End If
  On Error GoTo 0
  
  For lngSh = LBound(varSheets) To UBound(varSheets)
    If Evaluate("ISREF('" & varCells(lngSh) & "'!A1)") Then
      Set wsData = wbToOpen.Sheets(varCells(lngSh))
      For lngArr = LBound(varCells) To UBound(varCells)
        With wsToPaste
          lngFree = .Cells(.Rows.Count, 2 + lngArr).End(xlUp).Row + 1
          .Cells(lngFree, 2 + lngArr).Value = wsData.Range(varCells(lngArr)).Value
        End With
      Next lngArr
    Else
      If MsgBox("Sheet '" & varCells(lngSh) & "'could not be found." & vbCrLf & _
          "Continue or exit?", vbInformation, vbOKCancel) = vbCancel Then
        wbToOpen.Close SaveChanges:=False
        GoTo end_here
      End If
    End If
  Next lngSh
  wbToOpen.Close SaveChanges:=False
  
next_file:
  myFile = Dir
Loop

end_here:
Set wsData = Nothing
Set wbToOpen = Nothing
Set wsToPaste = Nothing
Set wbCallsCount = Nothing

Application.ScreenUpdating = True
End Sub

Ciao,
Holger

 

[Kristylee0228]

Hi Holger -
I came across an error message: "Sheet 'D2' could not be found. Continue or exit?"
So, I clicked ok and the same error message came up for each and every Cell Reference, not the actual Sheet Name.
Maybe an issue with the statement below??
The highlighted text below is what the error is referencing as "Sheet."
Other than this - the loop runs through each file in my folder as it should.

'array holding the cell addresses to proceed
varCells = Array("D2", "D3", "D4", "D5", "F2", "F3", "F4", "F5", "H2", "H3", "H4")
'array holdung the sheet names in the opened workbook
varSheets = Array("RPC Call 1", "RPC Call 2", "RPC Call 3", "RPC Call 4", "RPC Call 5")

All help is greatly appreciated!!

 

[HaHoBe]

Hi Kristy,

my bad - I mixed the arrays. Change the codelines

  For lngSh = LBound(varSheets) To UBound(varSheets)
    If Evaluate("ISREF('" & varCells(lngSh) & "'!A1)") Then
      Set wsData = wbToOpen.Sheets(varCells(lngSh))

which reference the cell addresses to

  For lngSh = LBound(varSheets) To UBound(varSheets)
    If Evaluate("ISREF('" & varSheets(lngSh) & "'!A1)") Then
      Set wsData = wbToOpen.Sheets(varSheets(lngSh))

for the names of the sheets. Sorry for that.

Holger

 

[Kristylee0228]

This worked perfectly. I appreciate your help!