How to create Macro to create new sheet, copy paste from other workbook??? Difficulty is workbook will have different file/sheet names.

V

veenkris

Board Regular
Joined
Sep 16, 2010
Messages
80
Hi,

Workbook 1
File and sheet names are always different. Only one sheet to start with. Macro to run from here and return here...

Workbook 2
File and sheet names are always the same.

I am trying to create a macro which in current workbook (1) creates a new sheet, opens another workbook (2), copies data, goes back to workbook 1 and pastes data on the new sheet. Goes back to first/original sheet in same workbook 1 (always different sheet name) and inserts a formula. Closes workbook 2.

I tried to write the following myself but get Compile Error: Expected Function or variable. With .activate highlighted. I expect that .Select will also produce an error. See blue text in code below.

Can someone advice how to correct my erros or do this differently? (VBA newbie/beginner)

Code: 
Sub MacroMultLoc()
'
' MacroMultLoc Macro
' Macro recorded 29-09-2010 by 
'
'
Dim Bk1 As Workbook
Dim Sh1 As Worksheet
Set Bk1 = ThisWorkbook
Set Sh1 = ActiveSheet
    Sheets.Add
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "ItemLocations"
    Range("A1").Select
    ChDir "K:\Sample\DoNotMove"
    Workbooks.Open Filename:="K:\Sample\DoNotMove\ItemsLocationReport.xls"
    Columns("A:F").Select
    Selection.Copy
 
    [B][COLOR=blue]With Bk1.[/COLOR][COLOR=blue]Activate[/COLOR][/B]
 
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Warehouse"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "ItemNo"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Location"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Amount"
    Range("G1").Select
 
    [COLOR=blue][B]With Sh1.Select[/B][/COLOR]
 
    Dim LR As Long
    LR = Range("L" & Rows.Count).End(xlUp).Row
    Range("p2:p" & LR).FormulaR1C1 = "=IF(SUMPRODUCT((ItemLocations!C[-14]=RC[-4])*(ItemLocations!C[-13]=RC[4]))>0,""No"",""Yes"")"
 
    ItemsLocationReport.xls.Close savechanges:=False
 
    Range("L1").Select
 
End Sub

Thanks
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
You are probably getting errors because you are processing three seperate worksheets and you are losing track of which one is the active sheet.

When dealing with multiple worksheets it is best to assign variables. In the code below, I have used the following names for the worksheets:
Code: 
[COLOR=#008000]'set the current wotksheet[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wsBk1 = ThisWorkbook.Worksheets("Sheet1")
 
   [COLOR=#008000]'add and set the item locations worksheet[/COLOR]
   Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "ItemLocations"
   [COLOR=darkblue]Set[/COLOR] wsItemLoc = Worksheets("ItemLocations")
 
[COLOR=green]'open and set the item report worksheet[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wbItemReport = Workbooks.Open(Filename:="C:\temp\veenkris\ItemsLocationReport.xls")
   [COLOR=darkblue]Set[/COLOR] wsItemReport = wbItemReport.Worksheets("Sheet1")

You are copying entire columns but there is no indication of where you are pasting them to. In this example I have assume the same columns A:F
Code: 
   [COLOR=green]'copy and paste[/COLOR]
   wsItemReport.Columns("A:F").Copy
   [COLOR=darkblue]With[/COLOR] wsItemLoc
      [COLOR=green]'paste in the columns from the Item Report sheet[/COLOR]
      .Columns("A:A").Insert Shift:=xlToRight

Because of this I have had to insert a new row for the headers
Code: 
      [COLOR=green]'insert new row and header[/COLOR]
      .Rows("1:1").Insert Shift:=xlDown
      .Range("A1").Value = "Warehouse"
      .Range("B1").Value = "ItemNo"
      .Range("C1").Value = "Location"
      .Range("D1").Value = "Amount"
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]

I used your code to insert the formula
Code: 
   [COLOR=darkblue]With[/COLOR] wsBk1
      lr = .Range("L" & .Rows.Count).End(xlUp).Row
      .Range("p2:p" & lr).FormulaR1C1 = "=IF(SUMPRODUCT((ItemLocations!C[-14]=RC[-4])*(ItemLocations!C[-13]=RC[4]))>0,""No"",""Yes"")"
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]

Rather than run the code Press F8 to step through it. As it comes to each line of code determine if it is working on the correct worksheet and pasting into the correct range.

Place the code in the ThisWorkbook module. Edit where highlighted.

Code: 
[COLOR=darkblue]Sub[/COLOR] MacroMultLoc()
   [COLOR=darkblue]Dim[/COLOR] wsBk1 [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] wsItemLoc [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] wbItemReport [COLOR=darkblue]As[/COLOR] Workbook
   [COLOR=darkblue]Dim[/COLOR] wsItemReport [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] lr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
 
   [COLOR=darkblue]Set[/COLOR] wsBk1 = ThisWorkbook.Worksheets("[COLOR=red]Sheet1[/COLOR]")
 
   Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "[COLOR=red]ItemLocations[/COLOR]"
   [COLOR=darkblue]Set[/COLOR] wsItemLoc = Worksheets("[COLOR=red]ItemLocations[/COLOR]")
 
   [COLOR=green]'get the information from the Item Report sheet [/COLOR]
   [COLOR=darkblue]Set[/COLOR] wbItemReport = Workbooks.Open(Filename:="[COLOR=red]C:\temp\veenkris\ItemsLocationReport.xls[/COLOR]")
   [COLOR=darkblue]Set[/COLOR] wsItemReport = wbItemReport.Worksheets("[COLOR=red]Sheet1[/COLOR]")
 
   [COLOR=green]'copy and paste[/COLOR]
   wsItemReport.Columns("[COLOR=red]A:F[/COLOR]").Copy
   [COLOR=darkblue]With[/COLOR] wsItemLoc
      [COLOR=green]'paste in the columns from the Item Report sheet[/COLOR]
      .Columns("[COLOR=red]A:A[/COLOR]").Insert Shift:=xlToRight
 
      [COLOR=green]'insert new row and header[/COLOR]
      .Rows("1:1").Insert Shift:=xlDown
      .Range("A1").Value = "Warehouse"
      .Range("B1").Value = "ItemNo"
      .Range("C1").Value = "Location"
      .Range("D1").Value = "Amount"
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
 
   [COLOR=darkblue]With[/COLOR] wsBk1
      lr = .Range("L" & .Rows.Count).End(xlUp).Row
      .Range("p2:p" & lr).FormulaR1C1 = "=IF(SUMPRODUCT((ItemLocations!C[-14]=RC[-4])*(ItemLocations!C[-13]=RC[4]))>0,""No"",""Yes"")"
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
 
   wbItemReport.Close SaveChanges:=[COLOR=darkblue]False[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wbItemReport = [COLOR=darkblue]Nothing[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wsItemReport = [COLOR=darkblue]Nothing[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wsItemLoc = [COLOR=darkblue]Nothing[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wsBk1 = [COLOR=darkblue]Nothing[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
Upvote 0
bertie said:
, I have used the following names for the worksheets:
Click to expand...

Thanks for your help. It does partially work and I am on the right track to solve this one.

A couple of questions and issues though....

Code: 
            .Range("p2:p" & lr).FormulaR1C1 = "=IF(SUMPRODUCT((ItemLocations!C[-14]=RC[-4])*(ItemLocations!C[-13]=RC[4]))>0,""No"",""Yes"")"
Here I am getting a file choosing or saving box called "Update Values: ItemLocations". I am not sure what to do here, so far I cancelled upon which the process continues. It is either looking for the file, or wanting to save a file???

The problem is most likely that the macro I am using is assigned to the hidden PERSONAL.xls.

I notice that the formulas are copied into its sheet. This is incorrect, it should be copied to the sheet I am using and starting the macro from.

The process in the beginning works fine. It opens the ItemLocations workbook and copies from its sheet the data, goes back to current workbook and creates a new sheet there, copy/pastes the data over...

Then it goes wrong, instead of going back to the sheet I was working on it goes to sheet1 of the PERSONAL.xls file.

The problem is that I need to run this macro on different files, always with different filenames. And in the file/book it has only one sheet which has the same name as the file name. Thus also always a different name.

How to tell the macro to go back to the book and sheet I started running the macro from?

Can we change
Code: 
[COLOR=darkblue]Set[/COLOR] wsBk1 = ThisWorkbook.Worksheets("Sheet1")
to something like
Code: 
[COLOR=darkblue]Set[/COLOR] wsBk1 = ThisWorkbook.Worksheets([I][SIZE=3][COLOR=blue]CurrentName[/COLOR][/SIZE][/I])

I do not know about the coding/programming language for this.

Or maybe there is another way for a macro to return to the file and sheet it starts from, keeping in mind that the macro is saved as a (hidden) PERSONAL.xls macro and runs from files with changing names, changing sheet names??????

Stepping through the rest of the macro I see that it closes the ItemLocations file nicely.

Almost there....
 
Upvote 0
On another website I found this ActiveWorkbook.Name

Is there something similar for a sheet, maybe ActiveSheet.Name ?????

And then how to integrate it into the code/macro??
 
Upvote 0
I have disabled alerts so you don't get the unwanted message and inserted an error trap to reset these if something goes wrong.

I have added a vriable to control the active worksheet name;
Code: 
   [COLOR=green]'get the name of the active worksheet and set it up[/COLOR]
[COLOR=black]  sheetName = ActiveSheet.Name[/COLOR]
[COLOR=black]  Set wsBk1 = Worksheets(sheetName)[/COLOR]

How does this work?

Code: 
[COLOR=darkblue]Sub[/COLOR] MacroMultLoc()
   [COLOR=darkblue]Dim[/COLOR] wsBk1 [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] wsItemLoc [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] wbItemReport [COLOR=darkblue]As[/COLOR] Workbook
   [COLOR=darkblue]Dim[/COLOR] wsItemReport [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] lr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] sheetName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
 
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] exitHere  [COLOR=green]'reset application settings before close[/COLOR]
[COLOR=red]  Application.DisplayAlerts = False[/COLOR]
[COLOR=red]  Application.ScreenUpdating = False[/COLOR]
 
   [COLOR=green]'get the name of the active worksheet and set it up[/COLOR]
[COLOR=red]  sheetName = ActiveSheet.Name[/COLOR]
[COLOR=red]  Set wsBk1 = Worksheets(sheetName)[/COLOR]
 
   Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "ItemLocations"
   [COLOR=darkblue]Set[/COLOR] wsItemLoc = Worksheets("ItemLocations")
   [COLOR=green]'get the information from the Item Report sheet and close it[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wbItemReport = Workbooks.Open(Filename:="C:\temp\ItemsLocationReport.xls")
   [COLOR=darkblue]Set[/COLOR] wsItemReport = wbItemReport.Worksheets("Sheet1")
 
   [COLOR=green]'copy and paste[/COLOR]
   wsItemReport.Columns("A:F").Copy
   wsItemLoc.Columns("A:A").Insert Shift:=xlToRight
   Application.CutCopyMode = [COLOR=darkblue]False[/COLOR]
   wbItemReport.Close SaveChanges:=[COLOR=darkblue]False[/COLOR]
 
   [COLOR=darkblue]With[/COLOR] wsItemLoc
      [COLOR=green]'insert new row and header[/COLOR]
      .Rows("1:1").Insert Shift:=xlDown
      .Range("A1").Value = "Warehouse"
      .Range("B1").Value = "ItemNo"
      .Range("C1").Value = "Location"
      .Range("D1").Value = "Amount"
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
 
   [COLOR=darkblue]With[/COLOR] wsBk1
      lr = .Range("L" & .Rows.Count).End(xlUp).Row
      .Range("p2:p" & lr).FormulaR1C1 = "=IF(SUMPRODUCT((ItemLocations!C[-14]=RC[-4])*(ItemLocations!C[-13]=RC[4]))>0,""No"",""Yes"")"
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
 
   [COLOR=darkblue]Set[/COLOR] wbItemReport = [COLOR=darkblue]Nothing[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wsItemReport = [COLOR=darkblue]Nothing[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wsItemLoc = [COLOR=darkblue]Nothing[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wsBk1 = [COLOR=darkblue]Nothing[/COLOR]
exitHere:
[COLOR=red]  Application.DisplayAlerts = True[/COLOR]
[COLOR=red]  Application.ScreenUpdating = True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
Upvote 0
bertie said:
I have disabled alerts so you don't get the unwanted message and inserted an error trap to reset these if something goes wrong.
...........
How does this work?
Click to expand...


Hi, thanks that is it. That works great.

I did remove the disable alerts code so that I can do troubleshooting if required. But it did not require any troubleshooting. Just adjusting the right references and it works just fine.

Code: 
 [COLOR=green]'get the name of the active worksheet and set it up[/COLOR]
[COLOR=black] sheetName = ActiveSheet.Name[/COLOR]
[COLOR=black] Set wsBk1 = Worksheets(sheetName)[/COLOR]
Is the solution!

Thanks again...
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
Copy paste from one Excel workbook to another with same sheet names and update dates in range
Replies
8
Views
514
Skiier89
S
A
  • Solved
Copy Entire Workbook, save as sheet name with current date, hide all sheets except one, & attach to email
Replies
2
Views
548
Amo840812
A
C
  • Question Question
How to get my macro to stop at the last recognized line
Replies
6
Views
547
Coco1
C
Lacan
  • Solved
How to clean in all cells the file path name after copy the sheet to a new workbook?
Replies
6
Views
128
Alex Blakenburg
A
G
  • Solved
Change Macro to import files from hyperlinks
2
Replies
12
Views
938
GarnesGambit
G

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top