Macro to extract Workbook in VBA Code

[howard]

I have the following code to coy data after sheet1 n the current workbook


I would like it amended to extract the name of the current workbook i.e "BR1 Sales.xlsm"

 nb.Sheets(1).Copy After:=Workbooks("BR1 Sales.xlsm").Sheets(1)

 

[JackDanIce]

Not sure what you mean, perhaps:

Msgbox Workbooks("BR1 Sales.xlsm").Name

 

[howard]

Thanks for the reply. What I would like is for code to extract the name from the workbook an place it in the code after:= workbooks("Br1..... ").sheets(1)


When the file is saved as BR1 Sales Jan 2017.xlsm, BR1 Sales Feb 2017.xlsm for eg , then the name after = Workbooks(" must change

 

[JackDanIce]

It's still not clear I'm afraid.

The name from what workbook?
The workbook you're running the code from?
A workbook the code has created?
A workbook you've opened in the same Excel instance as the one containing the code?
What is nb and how has it been declared?

At a guess, try:

nb.Sheets(1).copy after:=workbooks("BR1 Sales " & nb.name & ".xlsm")

 

[howard]

The name after = workbooks(" is the current workbook I.e the workbook containing this code

See Full Code below

 Sub Open_Workbook()


Dim nb As Workbook, tw As Workbook, ts As Worksheet
A = Application.GetOpenFilename
If A = False Or IsEmpty(A) Then Exit Sub
With Application
    .ScreenUpdating = False
    End With
Set tw = ThisWorkbook
Set ts = tw.ActiveSheet
Set nb = Workbooks.Open(Filename:=A, Local:=True)
nb.Sheets(1).Copy After:=Workbooks("BR1 Sales " & nb.name & ".xlsm").Sheets(1)
 Sheets(2).Name = "Imported Data"
With Range("C:J")
.EntireColumn.Delete
End With
  With Range("C:C")
   .EntireColumn.Hidden = True
  End With
 With Range("E:E")
   .EntireColumn.Hidden = True
  End With
  With Range("F:F")
 .EntireColumn.Hidden = True
  End With
  With Range("J:K")
 .EntireColumn.Hidden = True
 End With
    
End Subcc

 

[JackDanIce]

Isn't that the same as ThisWorkbook? Try:

Sub Open_Workbook()
    
    Dim wkb     As Workbook
    Dim strFile As Variant
                
    On Error Resume Next
        strFile = Application.GetOpenFilename
        Set wkb = Workbooks.Open(strFile, ReadOnly:=True, local:=True)
    On Error GoTo 0
    
    If wkb Is Nothing Then Exit Sub
    
    Application.screenupating = False
    
    With wkb
        .Sheets(1).Copy after:=ThisWorkbook.Sheets(1)
        .Close
    End With
    
    With Sheets(wkb.Sheets(1).Name)
        .Range("C:J").EntireColumn.Delete
        .Range("C:C").EntireColumn.Hidden = True
        .Range("E:F").EntireColumn.Hidden = True
        .Range("J:K").EntireColumn.hideen = True
    End With
    
    Application.ScreenUpdating = True
    Set wkb = Nothing
        
End Sub

 

[howard]

Thanks very much for the code. It works perfectly

 

[JackDanIce]

You're welcome