The code below adds a new worksheet to a summary workbook for every pagebreak in 2 other workbooks. I want to copy data from the other workbooks to each added sheet in the summary workbook. All of the data keeps copying only to sheet1. Thank you in advance for any help.
For n = 1 To Workbooks(file1name).Worksheets("Sheet1").HPageBreaks.Count
i = i + 1 'integer that tracks the pages being added
'SourceRange is a the range of data being copied
Set SourceRange = Workbooks(file1name).Worksheets("Sheet1").Range("A" & pgBreak, "Q" & Workbooks(file1name).Worksheets("Sheet1").HPageBreaks(n).Location.Row - 1)
SourceRange.Copy
summary.Sheets.Add 'summary is the summary workbook I would like to copy the data to
summary.Sheets(i).Activate
ActiveSheet.Paste
For j = 1 To Workbooks(file2name).Worksheets("Sheet1").HPageBreaks.Count
If matchVar = matchVar2 Then 'If the variable in workbook 1 matches the variable in workbook 2 than copy the information in between the page breaks
i = i + 1
Set SourceRange = Workbooks(file2name).Worksheets("Sheet1").Range("A" & pgBreak2, "Q" & Workbooks(file2name).Worksheets("Sheet1").HPageBreaks(j).Location.Row - 1)
SourceRange.Copy
summary.Sheets.Add
summary.Sheets(i).Activate
ActiveSheet.Paste
End If
Next
Excel adds the new sheet by default before active sheet, so your "Sheet1" is shifted each time you add a new sheet as that was the active one.
If you see the documentation of worksheet.add method you see that the newly created sheet is also activated, so don't need to activate it again, just paste your data ;)
Related
I have multiple workbooks running the same code, but behaving differently.
I think a user manually moved worksheets; changing the order.
The code uses
tempWs.Copy after:=ActiveWorkbook.Sheets(Worksheets.Count)
to copy a template sheet to the end of the workbook.
However, when running the following code in another module, the workbook seems to not recognize which sheet is the last sheet:
lastSh = ThisWorkbook.Worksheets.Count
....
ws.Cells(i,2).value = Worksheets(lastSh).Name
In some workbooks, the above code, as expected, returns the name of the last sheet (the newly created one).
In the workbooks with the odd behavior, lastSh points to the same sheet every time rather than recognizing I added another.
Another oddity: when I tried recreating the workbook by copying sheets from the erroring book to a new one, the error persists to that new version.
Why is the index of sheets seemingly stagnant or is my ".Copy after:=" doing something I don't know about?
Sub addToSummary()
Dim ws As Worksheet
Dim i, lastSh, lastRow As Long
Set ws = ThisWorkbook.Worksheets("Summary")
lastSh = ThisWorkbook.Worksheets.Count
lastRow = ws.Range("B6").End(xlDown).Row + 1
If ws.Cells(lastRow, 1).Value = "Total Amount Paid:" Then
Call addRow 'adds a row on a summary sheet if needed
ws.Cells(lastRow, 2).Value = Worksheets(lastSh).Name
Else
ws.Cells(lastRow, 2).Value = Worksheets(lastSh).Name
End If
ws.Cells(lastRow, 3).Formula = "='" + Worksheets(lastSh).Name + "'!currentPay"
End Sub
Regardless of creating a new file, this code is referencing the same sheet.
tempWs.Copy after:=ActiveWorkbook.Sheets(Worksheets.Count)
The number of sheets is not necessarily the same as the number of worksheets. If you have a chart sheet and 3 worksheets then Worksheets.Count is 3 but you have 4 Sheets so the sheet gets copied before the last sheet.
So you probably wanted this:
tempWs.Copy after:=ActiveWorkbook.WorkSheets(Worksheets.Count)
I'd like to run a macro that's reading all sheet names from an XLS file, and then being able to run the macro from the Run Command.
How is it possible?
For the moment I have the following code but I'd like to generalise it to other files (basically inputting the filename as a parameter in this macro and command).
Sub FnGetSheetsName()
Dim mainworkBook As Workbook
Set mainworkBook = ActiveWorkbook
For i = 1 To mainworkBook.Sheets.Count
'Either we can put all names in an array , here we are printing all the names in Sheet 2
mainworkBook.Sheets("Sheet2").Range("A" & i) = mainworkBook.Sheets(i).Name
Next i
End Sub
Create a macro enabled workbook.
Use one of the cell in Sheet1 to specify the path to excel file whose sheet names you want.
In Sheet1, insert an Active X Control button using developer mode.
In the code behind of the button (double click on the button keeping design mode enabled in developer tab -> VBA window opens), add following VB code and save it:
Private Sub CommandButton1_Click()
Dim sheetCount As Integer
Dim mainWorkBook, workbook1 As Workbook
Set mainWorkBook = ActiveWorkbook
Set workbook1 = Workbooks.Open(Range("A2"))
'Clear the contents of sheet 2, starting from row 2 - verify the last cell in sheet
Selection = mainWorkBook.Sheets("Sheet2").Range("A2:ZZ104857").ClearContents
If mainWorkBook.Sheets("Sheet1").Range("A2") = "" Then
MsgBox ("Enter Excel path")
GoTo exit1
End If
For sheetCount = 1 To workbook1.Sheets.Count
'Put sheet names of excel file in sheet 2 of macro book - you can find sheet names in Sheet2 starting from A2 cell.
mainWorkBook.Sheets("Sheet2").Range("A" & sheetCount + 1).Value = workbook1.Sheets(sheetCount).Name
Next sheetCount
exit1:
workbook1.Close (False)
End Sub
In the Sheet1 (of macro workbook), enter the excel path (whose sheetnames you want) in cell A2.
Click the Active X button (keeping design mode disabled).
You can find the result in Sheet2 of the macro workbook (Add suitable column names in first row of Sheet1 and Sheet2 of macro workbook for readability, if needed).
I need to create a new Worksheet in Workbook1 and name it according to a cell value.
I then need to copy and paste a value from Workbook1 into Workbook2 in order to run a model.
I then need to copy and paste the outputs of Workbook2 into the new worksheet i just created in Workbook1.
I then need to repeat this task until i have gone through all of entries in my list in Workbook1.
I keep running into multiple problems along the way.
The main problem i have is that the macro is having trouble selecting the value to copy and paste. I keep getting runtime error 9 and cannot resolve it.
I have created a Do Loop to try and complete all of the steps listed above.
I have also created a Do Loop inside of a Do Loop to produce the new Worksheet. This creates the tab but has placed the worksheet in both of the different workbooks following my attempts to rectify the error.
I also do not know how to refer to the new tab that i have created in the subsequent code so have written a placeholder called "NEW TAB" to signify this
The range of the outputs that is created by Workbook2 is different each time the model is run so i am trying to copy and paste 500,000 rows of data between workbooks each time. An 1004 error was produced saying this was too many rows.
' Variable Declaration
Dim Ws As Worksheet
Set Ws = Sheets("Universe")
Dim WorksheetNumber As Integer
WorksheetNumber = 1
'Open Workbook2
Workbooks.Open "Workbook2"
' Create Do Loop
' Create New Worksheet in Workbook1
ThisWorkbook.Activate
Ws.Range("B11").Select
Do While ActiveCell.Value <> ""
intTimes = intTimes + 1
If ActiveCell.Value > 0 Then
' Create Output Sheet
With ThisWorkbook.Sheets.Add(, ActiveSheet)
Do
.Name = WorksheetNumber
If Err = 1004 Then
WorksheetNumber = WorksheetNumber + 1
Err.Clear
Else
Exit Do
End If
DoEvents
Loop
End With
' Enter Value into Workbook2 from Workbook1
ThisWorkbook.Sheets("Universe").Range("O11").Copy Destination:=Workbooks("Workbook2").Sheets("Model").Range("E9")
' Copy and Paste Column D from Workbook2 to Workbook1
Workbooks("Workbook2").Worksheets("Model").Range("D14:D500000").Copy
Workbooks("ThisWorkbook").Worksheets("NEW TAB").Range("D2").PasteSpecial Paste:=xlPasteValues
'Copy and Paste Column G from Workbook 2 to Workbook1
Workbooks("Workbook2").Worksheets("Model").Range("G14:G500000").Copy
Workbooks("ThisWorkbook").Worksheets("NEW TAB").Range("E2").PasteSpecial Paste:=xlPasteValues
'Copy and Paste Remaining Details from Workbook2 to Workbook1
Workbooks("Workbook2").Worksheets("Model").Range("L14:U500000").Copy
Workbooks("ThisWorkbook").Worksheets("NEW TAB").Range("F2").PasteSpecial Paste:=xlPasteValues
End If
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "" Then
intTimes = 0
End If
Loop
The expected result is that a new tab will be created each time the model is run with the outputs from the model pasted into it each time. There will be up to 500 new tabs created (which will then need to be consolidated into a single tab).
I can't find the answer to this question anywhere in here or at else on the internet! So please help me:
Objective
1) I wan't to create a new sheet that I name, 2) thereafter I wan't to copy specific cells into this newly created sheet.
Background
I've seen thousands of videos explaining the code to create a new sheet and name it after what I write in a certain cell, so far so good. I've also seen thousands where you copy values into an already existing sheet, nice. But I can't find anyone describing how to create a new sheet, named as Idefine in a specific cell, and then copy values into it; and when I'm changing the name in the specific cell, I want to copy to that the new sheet.
Here's the code I did for the first part (working fine) and the second part (working not so fine):
sheet_name_to_create = Blad1.Range("e33").Value
For rep = 1 To (Worksheets.Count)
If LCase(Sheets(rep).Name) = LCase(sheet_name_to_create) Then
MsgBox "This sheet already exists!)"
Exit Sub
End If
Next
' börja kopieringen
Sheets.Add After:=ActiveSheet
Sheets(ActiveSheet.Name).Name = sheet_name_to_create
'Second part trying to copy and paste
'Now I want to copy values in "Blad1" to the newly made sheet ("sheet_name_to_create"). I know these codes are wrong, but it's what I got:
Range("A1:AM73").Select
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
ActiveWindow.Zoom = 25
' Or
WorksWorksheets("Blad1").Range ("A1:AF80").Copy Worksheets("sheet_name_to_create").Range ("A1:AF80")
Please help
When you create the new sheet, reference it - like so:
Set sourceSheet = ActiveSheet
Set destSheet = Sheets.Add(After:=sourceSheet)
You can now reference either the source worksheet or destination using sourceSheet and destSheet.
Then you can apply a name to your destSheet:
destSheet.Name = sheet_name_to_create
And then you can copy/paste from source to destination sheet:
sourceSheet.Range("A1:AM73").Copy destSheet
So your code becomes:
sheet_name_to_create = Blad1.Range("e33").Value
For rep = 1 To (Worksheets.Count)
If LCase(Sheets(rep).Name) = LCase(sheet_name_to_create) Then
MsgBox "This sheet already exists!)"
Exit Sub
End If
Next
Set sourceSheet = ActiveSheet
Set destSheet = Sheets.Add(After:=sourceSheet)
destSheet.Name = sheet_name_to_create
sourceSheet.Range("A1:AM73").Copy destSheet
ActiveWindow.Zoom = 25
I have 2 main sheets ( "kids" and "parents") and another 3 sheets that I use for data input. What I want the code to do is to copy the values of the 3 sheets from column A TO L and transfer them to the main sheets depending on the value chosen in column D. So if I insert data to one of the 3 sheets and I have as a value in column D "kids" it should transfer it to SHEET "KIDS" if I choose value "parents" the data should go to sheet "parents". In any case, I do want it to remove duplicates and not copy the same data each time I open the file.
Private Sub Workbook_Open()
Dim i As Long, lastRow As Long, ws As Worksheet
Sheets("Kids").Range("A3:L500").ClearContents
For Each ws In Worksheets
If ws.Name <> ("Kids") Then
ws.Activate
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If ws.Cells(i, "D").Value = "Kids" Then
Rows(i).Copy Destination:=Sheets("Kids").Range("A" & Rows.Count).End(xlUp).Offset(1)
ElseIf ws.Cells(i, "D").Value = "Parents" Then
Rows(i).Copy Destination:=Sheets("Parents").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End If
Next ws
End Sub
So this is the code I have used but it doesn't remove duplicates for main sheet "parents". Something is wrong...
Your question is not conveying total situation of your problem as mentioned by #Nicolas. However to help you with your problem go to the code posted by #fbonetti in the following thread to remove duplicates.
[delete-all-duplicate-rows-excel-vba:]Delete all duplicate rows Excel vba
Further to transfer Copy Data to Another Excel WorkBook Based on Criteria Using VBA to do is the following:
1. Identify data in a workbook sheet based on a text criterium and a date criterium or condition using a looping process
2. Select the specific data which meets the two or multiple conditions
3. Copy the identified data
4. Open another workbook
5. Find the first blank row in a specific worksheet in the workbook
6. Paste the data in the identified blank or empty row – erow
7. Save the workbook
8. Close the workbook
Go through the link mentioned below.
http://www.exceltrainingvideos.com/copy-data-to-another-excel-workbook-based-on-criteria-using-vba/
HTH