VBA to copy two sheets together and get 100 copies - vba

I have two template sheets (linked), I would like to create about 100 times of both, and rename them as per the list on sheet "Output-->>>" form cell A381. eg. tesco, tesco LL
The below code doesnt work, can anyone help please?
Sub makeSheets()
Dim sh1 As Worksheets, sh2 As Worksheet, c As Range
Set sh1 = Sheets(Array("Template", "Template LL"))
Set sh2 = Sheets("Output-->>>")
For Each c In sh2.Range("A381", sh2.Cells(Rows.Count, 2).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
Next
End Sub
Many thanks

Related

VBA Loop: Copy Range from Multiple Worksheets to Multiple Set Locations

I initially used the code (below) to compile data from 15 worksheets into a "template" sheet. It does this very well-- however, the needs of the workbook have changed somewhat.
Rather than copying this data into a relative location (the first empty cell in "template" column A), I now need to arrange the data into set locations, offset by 25 on each loop.
Ex:
wks 1 copy to A3 /
wks 2 copy to A28 /
wks 3 copy to A53 / etc
I have been trying to troubleshoot, but I'm still very weak when it comes to loops. Can anyone help me out?
Sub test()
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "template" Then
wks.Range("B6:B30").Copy
ActiveSheet.Paste
Destination:=Worksheets("template").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End Sub
Try this. Assume the copied data is never more than 24 rows?
Sub test()
Dim wks As Worksheet, r As Range
Set r = Worksheets("template").Range("A3") 'initial paste range
For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "template" Then
wks.Range("B6:B30").Copy r
Set r = r.Offset(25) 'move down 25
End If
Next
End Sub

Sub that copies/pastes from defined names on different worksheets

I have the following Problem:
I have two (dynamic) lists that are named MarketsEquities and MarketsBonds and are found on worksheets SummaryEquities and SummaryBonds, respectively.
I then have a worksheet named PnL where I want to create a list of the markets listed in the previous worksheets. These Markets should all be listed in column C and a space should be provided between the end of the equities list and the start of the bond list, wherein I shall write in column B Bonds.
This is what I've got thus far:
Sub InsertEquitiesBonds()
Dim ws As Worksheet, r1 As Range, r2 As Range
Set ws = Worksheets("PnL")
ws.Activate
Set Range("B3").Value = "Equities"
Set r1 = Worksheets("SummaryEquities").Range("MarketsEquities")
r1.Copy Range("C4")
'I want to then insert "Bonds" in Column B at the end of the listing of equities and then list all bonds in column C below that.
Set r2 = Worksheets("SummaryBonds").Range("MarketsBonds")
End Sub
Help is greatly appreciated.
I recommend to specify a worksheet for every Range() or Cells() statement like ws.Range("C4") otherwise Excel guesses which worksheet you mean.
You can determine the last used cell in a column with
ws.Cells(ws.Rows.Count, "B").End(xlUp) 'last used cell in column B
and you can use .Offset(row, column) to move rows/columns relatively from that cell.
So I suggest the following:
Public Sub InsertEquitiesBonds()
Dim ws As Worksheet
Set ws = Worksheets("PnL")
ws.Range("B3").Value = "Equities"
Worksheets("SummaryEquities").Range("MarketsEquities").Copy ws.Range("C4")
Dim LastUsedCell As Range
Set LastUsedCell = ws.Cells(ws.Rows.Count, "B").End(xlUp) 'last used cell in column B
LastUsedCell.Offset(2, 0).Value = "Bonds" 'move 2 cells down and write Bonds
Worksheets("SummaryBonds").Range("MarketsBonds").Copy LastUsedCell.Offset(3, 1) 'copy MarketsBonds 3 cells down and one cell right of the last used cell
End Sub

Excel VBA Cycle For

I have a file named vegetables_fruits and 4 other files : apple, banana, tomato, cucumber. In the file vegetables_fruits I have a Worksheet named List where I fold the names of all 4 files (ex., cell A2 = apple, cell A3 = banana, cell A4 = tomato, cell A5 = cucumber). In addition to the sheet List I have sheets banana, tomato and cucumber, but I don't have apple.
It's necessary to paste the column A from each of this 4 files to every sheet in the vegetables_fruits (ex., from file apple it's necessary to copy column A to file "vegetables_fruits" to sheet "banane" ; from file "banana" it's necessary to copy column A to file vegetables_fruits to sheet tomato etc.) Thank you very much for your help!
P.S. It needs to create a For, but I don't know how I can decribe all of this conditions.
Sub CopyPaste()
Dim r As Variant
Dim a As Variant
Dim b As Integer
Dim nbcells As Integer
Dim ws As Worksheet
Worksheets("List").Activate
nbcells = Application.WorksheetFunction.CountA(Range("A2:A" & Range("A65536").End(xlUp).Row))
' === Create a new sheet ===
For r = 2 To nbcells
Sheets.Add After:=Sheets(Sheets.Count - 1)
Worksheets(r).Name = Worksheets("List").Cells(r + 1, 1).Value
Next r
' === DATA ===
For Each ws In Sheets
If ws.Name Like "*.xls*" Then
For a = 2 To nbcells
Windows(a).Activate
Range("B:B").SpecialCells(2).Copy
Workbooks("vegetables_fruits.xlsm").Activate
b = a + 1
If ws.Name = Worksheets("List").Cells(b, 1).Value Then
ws.Select
Range("A2").Select
ActiveSheet.Paste
End If
Next a
End If
Next
End Sub
Maria - Reading your question, I think the additional logic you need is as follows:
Assume all workbooks are open, and have the appropriate name.
Loop through all of the workbooks.
If I find a workbook with one of my defined names, then copy Column A from (some sheet) in that workbook
Paste this into the master workbook, on the sheet with the corresponding name.
For my example, you would need to add these variables in the section where the variables are declared.
Dim fromWS As Worksheet, toWS As Worksheet
Dim wb As Workbook, myWB As Workbook
Early in the code, near the top, you will need this line of code.
Set myWB = ActiveWorkbook
Later in the code, this Loop and Case statements will accomplish the above logic ...
For Each wb In Workbooks
Select Case wb.Name
Case "apple"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("apple")
Case "banana"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("banana")
Case "tomato"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("tomato")
Case "cucumber"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("cucumber")
Case Else
End Select
fromWS.Range("A:A").Copy toWS.Range("A:A")
Next wb
You talk about there not being an "apple" sheet. This is a nuance you may need to build exception logic for. (e.g. just omit that case in the above loop)

Paste worksheet names in multiple worksheets

I have a workbook with over 50 worksheets. I would like to copy the name of each worksheet into a cell of that particular workbook. I can do it for one sheet at a time using a macro with the following VBA code:
Range("B1") = ActiveSheet.Name
But when I try to apply the macro to several worksheets at a time, it fails. I would like it to get the names of the first 30 worksheets only.
Avoid relying on the ActiveSheet property to identify the worksheet you want to process. The With ... End With statement can readily provide the worksheet and help retrieve the Worksheet .Name property.
Sub name_Worksheets()
Dim w As Long
For w = 1 To 30
With Worksheets(w)
.Cells(1, 2) = .Name
End With
Next w
End Sub
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
My Understanding is you want to 1) Go through first 30 sheets of your workbook and 2) Paste the sheet name into cell B1.
Sub PasteSheetNameInB1()
For i = 1 To 30 '(1 to 30 because you said " I would like it to get the names of the first 30 worksheets only.")
ActiveWorkbook.Sheets(i).Select 'Iterates through first 30 sheets
Range("B1") = ActiveSheet.Name 'Pastes Sheet name into B1
Next i
End Sub
You can use this code:
For i = 1 To 30
Sheets(i).Range("B1").Formula = "=MID(CELL(""filename"",A1),FIND(""]"",CELL(""filename"",A1))+1,255)"
Next
Now if you change the name of any worksheet, You don't need to run the macro again, the formula in Rnage("B1") will display the new name.
So with this code, that you'll paste in the destination workbook,
you'll just need to change :
workbook_to_scan's Name and
Sheet's name in which to paste the names
to fit your needs!
Sub test_johnB()
Dim wB1 As Workbook, _
wB2 As Workbook, _
wSDest As Worksheet, _
wS As Worksheet, _
i As Integer
Set wB1 = ThisWorkbook
Set wB2 = Workbooks("workbook_to_scan's Name")
Set wSDest = wB1.Sheets("Sheet's name in which to paste the names")
i = 0
For Each wS In wB2.Sheets
wSDest.Range("B1").Offset(i, 0) = wS.Name
Next wS
End Sub

Compare 2 columns in 2 workbooks, copy matched row if match is found

I have two workbooks (or 2 sheets): Workbook A and Workbook B.
I want to compare:
Columns B and C in Workbook A WITH
Columns A and B in Workbook B
If a Match is found THEN
I need to copy the MATCHED row from Workbook B and paste it onto the MATCHED row on workbook A.
In other words: I need to copy the cell values of Columns C and D of the matched row of Workbook B onto cells of columns D and E of matched row in Workbook A.
What I have so far only compares the 2 columns which I'm hoping is correct.
The code below is for 2 sheets instead of two workbooks:
Sub compareNcopy()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets(2): Set sh3 = Sheets(3)
Dim i As Long, j As Long,
Dim lr1 As Long, lr2 As Long
Dim nxtRow As Long
Dim rng1 As Range, rng2 As Range, rng3 As Range
lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lr1
Set rng1 = sh1.Range("A" & i)
For j = 1 To lr2
Set rng2 = sh2.Range("A" & j)
If StrComp(CStr(rng1.Value), CStr(rng2.Value), vbTextCompare) = 0 Then
If rng1.Offset(0, 1).Value = rng2.Offset(0, 1).Value Then
End If
End If
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next i
End Sub
Help would be much appreciated.
To copy between 2 sheets (or even two books) is pretty much the same as if you were copying to another cell in the same sheet (or book), you just have to specify which sheet (or book). What you would want to do is something along the lines of:
sh2.Cells(j,3).Resize(1,2).Copy Destination:=sh1.Cells(i,3).Resize(1,2)
This is for if the data you want to copy is found in sh2. If it is the other way around, switch the sh2 and sh1, and the j and i.
If you want to copy between workbooks, you will need to add Workbooks(wb1). in front of the Sheets(sh2). specifier, with wb1 being the workbook variable.
EDIT: Since sh2 in essence is Sheets(2) what I had previously shown was Sheets(Sheets(2)) which makes no sense and that is why the error was popping up. My apologies. Instead of using Sheets(sh2) just use sh2, and the same goes for sh1. I have fixed the above code to reflect this.