When I use the code below
ThisWorkbook.Sheets("DB_Main").Copy _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
I end up with a new sheet named DB_Main (2)
I am looking for a way to print these 2 sheets from my "Main" sheet using a button.
From sheet DB_Mainthe pages 4 and 5, and from sheet DB_Main (2)the pages 4,5,6 and 7.
How can I detect a copied sheet?
Any ideas how to get this to work?
If you copy a sheet, it gets automatically the active sheet. Assign this to a variable, after that you can do whatever you want:
Dim oldWs As Worksheet
Set oldWs = ThisWorkbook.Sheets("DB_Main")
oldWs.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Dim newWs As Worksheet
Set newWs = ActiveSheet
' Rename the sheet if you want
newWs.Name = "I am brand new"
' Print out old Main and copy
wb.Worksheets(Array(oldWs.Name, newWs.Name)).PrintOut
I try to loop all sheets and compare the cell A1 if its equal to 1.
Its work like that.
Private Sub CommandButton6_Click()
Dim allshts As Worksheet
For Each allshts In ActiveWorkbook.Worksheets
If allshts .Range("A1").Value = 1 Then
allshts .PrintOut From:=1, To:=1
End If
Next allshts
End Sub
Related
I want to simply copy the first row "test" into all following sheets (Sheetxx1, Sheetx23, Sheet231, etc. ) ... (like 100 following sheets with different names).
So I tried this by recording a macro (with relative reference) and then went on the sheet, where I want to have it pasted (like Sheetx231) and then did run the macro. But what it did is it pasted again row "test" into Sheetxx23.
How can I make the macro paste the row test of Sheetxx1 into the recent sheet (I am in and run the macro)?
Sub Macro1()
Rows("1:1").Select
Selection.Copy
Sheets("Sheetxx23").Select
ActiveCell.Rows("1:1").EntireRow.Select
ActiveSheet.Paste
End Sub
You need to loop throuh all worksheets and copy/paste for each worksheet.
Option Explicit
Public Sub CopyFirstRowIntoAllWorksheets()
Dim SourceWs As Worksheet
Set SourceWs = ActiveSheet
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 'loop throuh all sheets
If Not ws.Name = SourceWs.Name Then 'makes sure source and destination is not the same sheet
SourceWs.Rows(1).Copy Destination:=ws.Rows(1) 'copy first row
End If
Next ws
Application.CutCopyMode = False
End Sub
You might benefit from reading
How to avoid using Select in Excel VBA.
Edit according comment:
If you need only the worksheets right of the active worksheet to be pasted, replace
If Not ws.Name = SourceWs.Name Then
with
If ws.Index > SourceWs.Index Then
I have created the following Excel-spreadsheet:
A B C D E
1 Sheet1
2 Sheet2
3 Sheet5
4 Sheet6
5 Sheet8
6 Sheet9
7
As you can see, in Column A I have listed some of the sheets within the Excel file.
Now, I use the below VBA to get this list into a ComboBox:
Sub UserForm_Activate()
ComboBox1.List = Sheet1.Range("A1:A8").Value
End Sub
All this works fine so far.
However, now it can happen that some of the sheets are not visible. Therefore, I also do not want them to appear in the ComboBox.
One solution I found was the answer from here. However, this VBA only works over the entire Excel file but as you can see in my list above some sheets (Sheet3, Sheet4, Sheet7) are excluded from the list. Those sheets should also remain excluded no matter if they are visible or not.
So for example, when I make Sheet2 and Sheet6 invisible the list in the ComboBox should automatically be adjusted and look like this:
Sheet1
Sheet5
Sheet8
Sheet9
What do I need to change in my VBA to achieve this?
The code below puts the sheets from the worksheet into a dynamic array and checks if it's visible, so you're not hard-coding the visible sheets. Therefore, excluding the sheets you don't want (Sheet3, Sheet4 and Sheet7) from the worksheet will also exclude them from your ComboBox.
Private Sub UserForm_Activate()
Dim sheet_list As Variant
sheet_list = Sheet1.Range("A1:A8").Value
'get the list of Sheets from Column A
Dim combo_list As Variant
combo_list = Array()
'create and empty array
Dim sheet_name As Variant
For Each sheet_name In sheet_list
'loop through sheets
If ThisWorkbook.Worksheets(sheet_name).Visible Then
'check if they are visible
Dim ub As Long
ub = UBound(combo_list) + 1
ReDim Preserve combo_list(ub)
'increment array dimension
combo_list(ub) = sheet_name
'add Sheet to array
End If
Next sheet_name
ComboBox1.List = combo_list
'populate the ComboBox
End Sub
Based on linked topic I modified the code from answer to reach what You want to achieve
Private Sub ChangeComboBox()
Dim xSheet As Worksheet
' Clear the combobox
ComboBox1.Clear
' Add the sheets again
For Each xSheet In ThisWorkbook.Sheets
'~~> Check if they are visible
If xSheet.Visible = xlSheetVisible Then
If xSheet.Name <> Sheet3.Name And xSheet.Name <> Sheet4.Name And xSheet.Name <> Sheet7.Name Then
ComboBox1.AddItem xSheet.Name
End If
End If
Next
End Sub
To all,
thanks for your time in advance.
we already have working code to move data from one wrksht to another with vb in excel.
we use:
Set lastrow = Sheets ("SR log").Cells(Rows.Count, 1).End(x1UP)
With LastRow
This places our selected data on the last open row of sheet 2
Is it possible to , instead of the last row, Search for a reference number from the first sheet that is already on the second sheet , lets say Cell G3. use the information from the first sheet in cell g3 and look for it on the second sheet.
Once that row is found ( the G3 data from the first sheet will be in column A of the second sheet)
Now apply data to that row where applicable.
any help would be appreciated.
2/22/19
Here is my response.
thankyou for taking the time
I have put something together but wanted to run it by before executing
[code]
Private Sub CommandButton2_Click()
Workbooks.Open Filename:="G:\General\COVER SHEET_Protective\Protective Packaging Order Log.xlsm", Password:="PP", WriteResPassword:="PP"
Dim FoundRow As Variant
FoundRow = Application.Match(Sheets(1).Range("G3"), Sheets(2).Columns(1), 0)
If IsNumeric(FoundRow) Then
With FoundRow
' found, use FoundRow like LastRow before
End With
Else
' not found :(
End If
.Offset(1).Font.Size = 14
.Offset(1, 9) = ws.[I10]
.Offset(1, 10) = ws.[I11]
End Sub
[/code]
I'm am a little unsure about this row
[code]
Application.Match(Sheets(1).Range("G3"), Sheets(2).Columns(1), 0)
[/code]
the match sheets 1 on the first workbook is called worksheet
and on the second workbook where the search is happening on the first
column
the sheet is called orderlog
thanks
You can find the matching row with Application.Match:
Private Sub CommandButton2_Click()
Dim wb1 As Workbook ' first workbook
Dim wb2 As Workbook ' second workbook
Dim wsCheck As Worksheet ' sheet in the first workbook
Dim wsOrderlog As Worksheet ' sheet in the second workbook
' address the first workbook and its sheet
' if this VBA-code is in the frist workbook, it's "ThisWorkbook"
Set wb1 = ThisWorkbook
Set wsCheck = wb1.Worksheets("Worksheet")
' check, if second workbook is already open
For Each wb2 In Workbooks
If wb2.Name = "Protective Packaging Order Log.xlsm" Then Exit For
Next wb2
' if not already open, then open it, and address its sheet also
If wb2 Is Nothing Then
Set wb2 = Workbooks.Open( _
Filename:="G:\General\COVERSHEET_Protective\Protective Packaging Order Log.xlsm", _
Password:="PP", _
WriteResPassword:="PP")
End If
Set wsOrderlog = wb2.Worksheets("orderlog")
' search a value from the first workbook's sheet within second workbook's sheet
Dim FoundRow As Variant
FoundRow = Application.Match(wsCheck.Range("G3").Value, wsOrderlog.Range("A:A"), 0)
If IsNumeric(FoundRow) Then ' if found
' please adapt to your needs:
wsOrderlog.Cells(FoundRow, 1).Font.Size = 14
wsOrderlog.Cells(FoundRow, 9).Value = wsCheck.Range("I10").Value
wsOrderlog.Cells(FoundRow, 10).Value = wsCheck.Range("I11").Value
Else
MsgBox "Sorry, the value in cell G3" & vbLf & _
wsCheck.Range("G3").Value & vbLf & _
"could not be found in orderlog column A."
End If
' close the second workbook (Excel will ask, if to save)
wb2.Close
End Sub
I have a workbook that consists of 180 worksheets. Each worksheet has the top 9 rows and columns A1:Z1 with information that I do not need.
The rest of the worksheet has data that I do need and want to append into one worksheet. The problem is that each of the worksheet has drop-down choices embedded in them. The choices have already been made and I need to append the sheets with the choices selected.
Been trying to run a VBA script but have been unsuccessful. Any help is greatly appreciated.
Thank you
Current code that I used to remove the top rows for few of the sheets, only removal but not appending. And I have inserted sheet names, but with 180 sheets that will not be possible.
Sub remove_rows()
'
' remove_rows Macro
'
'
`Rows("1:10").Select`
`Selection.EntireRow.Hidden = False`
`Range("D20").Select`
`Rows("1:9").Select`
`Range("A9").Activate`
`Selection.Delete Shift:=xlUp`
`Sheets("BioME-Box- (2)").Select`
`Rows("1:15").Select`
`Selection.EntireRow.Hidden = False`
`Rows("1:9").Select`
`Range("A9").Activate`
`Selection.Delete Shift:=xlUp`
`Sheets("BioME-Box- (3)").Select`
`Rows("1:13").Select`
`Selection.EntireRow.Hidden = False`
Rows("1:9").Select
Range("A9").Activate
Selection.Delete Shift:=xlUp
It sounds like you are talking about Validation lists as your "drop down" lists. If so then they might be getting their options from a another range somewhere else. So if you delete a range that the validation lists are using then all of their options disappear. I don't know if this is your problem. But you can copy a validation list and paste only its value, not the whole list, this way.
Sub Macro1()
Range("D3").Select ' This is the validation list
Selection.Copy
' Change "SomeOtherRangeHere" to any cell you want to
Range("SomeOtherRangeHere").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Try this one. Be sure to change mainWS to the worksheet you are copying to. I used sheet1 but you may be using another. In this sub it copies everything below Row 9 of all sheets and pastes them to the first available row in sheet1.
Sub Macro1()
Dim ws As Worksheet, mainWS As Worksheet
Dim wsLastRow As Long, mainWSlastRow As Long, wsLastCol As Long
Set mainWS = Sheet1 ' Change this to the sheet you are copying everthing to
For Each ws In ThisWorkbook.Worksheets
def = mainWS.Name
abc = ws.Name
If ws.Name <> mainWS.Name Then ' Make sure to not copy from the sheet yuo are copying to
wsLastRow = ws.UsedRange.Rows.Count
wsLastCol = ws.UsedRange.Columns.Count
On Error Resume Next
mainWSlastRow = Sheet1.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
If Err.Number = 91 Then
mainWSlastRow = 1
On Error GoTo 0
End If
ws.Range("A10:" & Chr(wsLastCol + 64) & wsLastRow).Copy Destination:=mainWS.Range("A" & mainWSlastRow + 1)
End If
Next ws
Set mainWS = Nothing
Set ws = Nothing
End Sub
I would really appreciate it if someone can help me with a VBA. Loop through multiple worksheet in same WorkBook and copy 1 column i.e. col B, and paste/append in the next blank column in the active worksheet.
Thanks,
Adil
There are some limitations here but this should get you started.
Sub copyColumn()
Dim wks As Worksheet
Set wks = ActiveSheet
'Source worksheet to copy from
Dim srcwk As Worksheet
Set scrwk = ActiveWorkbook.Worksheets(3)
'Copy range A1:A10 from source to active sheet in next open column
scrwk.Range("A1:A10").Copy wks.Range("IV1").End(xlToLeft).Offset(0, 1)
End Sub
Something like this?
Sub Move_Column()
CurrWS = ActiveSheet.Name
For each Sheet in ActiveWorkbook.Sheets
If Sheet.Name <> CurrWS Then
NextColumn = Sheets(CurrWS).Range("XFD1").End(xlToLeft).Column + 1
Sheets(CurrWS).Range(Sheets(CurrWS).Cells(1, NextColumn), Sheets(CurrWS).Cells(100, NextColumn)).Value = Sheet.Range(Sheet.Cells(1, 2), Sheet.Cells(100, 2)).Value
End if
Next
End Sub