I have 2 workbooks.
Source Workbook
- Select a cell in column B, last row of a table. e.g. B29 (But this would change as the table grows)
2nd Workbook
- Paste that cell into G14 of the 2nd workbook (This doesn't change)
Source Workbook
- Select a cell in column D, same row - last row of table. e.g.. D29
2nd Workbook
- Paste that cell into D8 (This doesn't change)
This same process repeats 4 more times (Columns E-H) and all the pasting is done into C3, F14, I14 and E14 respectively.
The following code will do what you need. Just make the changes mentioned in the comments.
Sub Copy2Workbook() 'You need to place this in your source workbook!
Dim wbT As Workbook ' target workbook
Set wbT = Workbooks("United")
Dim shtT As Worksheet 'target worksheet
Set shtT = wbT.Worksheets("Name of target sheet") ' change name to fit your case
Dim shtS As Worksheet 'source worksheet
Set shtS = ThisWorkbook.Worksheets("Name of source sheet") ' change name to fit your case
Dim lastRow As Long
'*****************************************
lastRow = shtS.Cells(Rows.Count, "B").End(xlUp).Row
shtT.Range("G14").Value = shtS.Range("B" & lastRow).Value
'repeat the two lines of above while changing the references to your needs
End Sub
Related
i wanna to look for sheet 2 column H value in sheet 1 column A and then copy and paste matching data from sheet 1 to sheet 2 column A last empty row.. had written below VBA but somehow not all matching line can be copied and paste from sheet 1.. and for those just newly copy and paste from sheet 1 data, is carrying value for column H, again i need to look for this column H new data from sheet 1 and then copy and paste to sheet 2 (repeat same action)...how to write VBA for doing this continuos action then VBA stop when all column H data is already referenced and having copy and paste line from sheet1?
Had tried to write below VBA according to i wanna to achieve result.
Sub MatchData()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastRow1 As Long, lastRow2 As Long, lastRowA As Long
Dim i As Long, j As Long
Dim matchFound As Boolean
'Set worksheet variables
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
'Get last row for both sheets
lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "H").End(xlUp).Row
'Get last row in Sheet2 column A
lastRowA = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
'Loop through Sheet2 column H data and match with Sheet1 column A
For i = 1 To lastRow2
matchFound = False 'Reset matchFound flag for each row
If Not IsEmpty(ws2.Cells(i, 8)) Then 'Check if Sheet2 column H cell is not empty
For j = 1 To lastRow1
If ws2.Cells(i, 8) = ws1.Cells(j, 1) And ws2.Cells(i, 9) = ws1.Cells(j, 2) Then 'Match found
matchFound = True
'Check if matching row is a duplicate
If WorksheetFunction.CountIf(ws2.Range("A1:B" & lastRowA), ws1.Cells(j, 1).Value & ws1.Cells(j, 2).Value & ws2.Range("A" & i).Value & ws2.Range("B" & i).Value) = 0 Then
'Copy matching row to Sheet2 column A last empty row
ws1.Rows(j).EntireRow.Copy ws2.Cells(lastRowA + 1, "A")
lastRowA = lastRowA + 1 'Update last empty row in Sheet2 column A
End If
End If
Next j
End If
Next i
MsgBox "Matching and copying rows completed!"
End Sub
I am trying to update an OLAP pivotfilter with the value of another cell (not in a pivot table).
The code I have is as follows:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when
'cell C1 or C2 is touched
If Intersect(Target, Range("C1:C2")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewStock As String
'Here you amend to suit your data
Set pt = ActiveSheet.PivotTables("PivotFilter")
'The activesheet is named "Top1_Value"
Set Field = pt.PivotFields("[StockCode].[Stock Code_SKU].[Stock Code_SKU]")
NewStock = ActiveSheet.Range("C1").Value
'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.VisibleItemsList = NewStock
pt.RefreshTable
End With
End Sub
Any assistance to resolve would be appreciated.
My code takes a file name from TextBox1, opens that file and indexes through all the unique values in column B. It then takes a second file, file name in TextBox2, and filters it based on the current index from the first file. It then takes the filtered results and copies them to a sheet in the new workbook. A new sheet is then generated in the new workbook to paste the next filtered result.
My issue is that I have many rows of data and for some reason the filtered data is not be selected after many iterations. My program selects all filtered data when it starts, but at some point it just begins selecting the headers instead of all the visible cells. Let me know if I am missing something or if there is a quick workaround. Thank you.
Sub NewFileGenerate()
Dim I As Integer
Dim N As Integer
Dim X As Integer
Dim IndexedCell As String
X = 1
Windows(TextBox1.Value).Activate
'Need to count only populated cells
I = Sheets(1).Columns(2).Cells.SpecialCells(xlCellTypeConstants).Count
Set Newbook = Workbooks.Add
For N = 2 To I - 1
Application.CutCopyMode = True
Windows(TextBox1.Value).Activate
IndexedCell = Cells(N, 2).Value
Windows(TextBox2.Value).Activate
With Sheets(1)
With .Range("A1", "Z" & I - 1)
.AutoFilter Field:=5, Criteria1:=IndexedContract
.SpecialCells(xlCellTypeVisible).Copy
End With
End With
Newbook.Activate
ActiveSheet.Paste Destination:=Sheets(X).Range("A1:Z1")
Cells.Select
Selection.Font.Size = 10
Cells.EntireColumn.AutoFit
Cells.Select
X = X + 1
If X > 3 Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Sheet" & X
End If
Application.CutCopyMode = False
Next N
End Sub
I'm guessing that your source worksheet (textbox2.value) has more rows than your index worksheet (textbox1.value). You set I equal to the number of rows in your index worksheet, then you tell the autofilter to only use that number of rows. You need to change the line "With .Range("A1", "Z" & I - 1)" so it picks up all of the rows in your source worksheet.
I am new to scripting and perform lot of activity as an analyst using excel sheets.
I have two files with list of items in it.
File1 contains 1 column
File2 contains 2 columns.
I want to check if the list present in column1 of file2 is same as in column1 of file2. If yes then it should print column1File1, column1File2 and coulmn2File2 in file3 else it should print "NA", column1File2, column2File2 in file3.
Please help, It will simplify my work a lot.
I made this program a while ago, although it will iterate through sheets in 1 workbook, and compare cell by cell, it may set you in the right direction. It would take a cell in 1 "master" sheet and then iterate through each sheet to find that in a particular column. After it found it the counter would increment, then it would take the next cell in the master sheet and so on. you could alter to use multiple books and take whatever cells you want and compare them.
Sub Open_Excel()
'Use worksheetNum as sheet to read/write data
Set currentWorkSheet = objExcel.ActiveWorkbook.Worksheets(worksheetNum)
'How many rows are used in the current worksheet
usedRowsCount = currentWorkSheet.UsedRange.Rows.Count
'Use current worksheet cells for values
Set Cells = currentWorksheet.Cells
'Loop through each row in the worksheet
For curRow = startRow to (usedRowsCount)
'Get computer name to ping to
strEmailAddressSource = Cells(curRow,colEmailAddressSource).Value
strServerSource = Cells(curRow,colHostserverSource).Value
strLocationSource = Cells(curRow,colLocationSource).Value
'make the values unique
strconcatenation = strServerSource & strLocationSource
Call Comparison()
Next
End Sub
'********************************************************************************************
'**** Comparison
'********************************************************************************************
'Comparison test
Sub Comparison()
'choose the worksheets to go through
For worksheetCounter = 6 to 9 'workSheetCount
Set currentWorkSheetComparison = objExcel.ActiveWorkbook.Worksheets(worksheetCounter)
usedRowsCountNew = currentWorkSheetComparison.UsedRange.Rows.Count
'First row to start the comparison from
For rowCompare = 2 to (usedRowsCountNew)
strEmailLot = currentWorkSheetComparison.Cells(rowCompare,colEmailAddressLot).Value
comp1 = StrComp(strEmailAddressSource,strEmailLot,0)
comp2 = StrComp(strconcatenation,reportConcat,0)
'check if the values match
If ((comp1 = 0) AND (comp2 = 0)) THEN
countvalue = countvalue + 1
End If
Next
Next
End Sub
Suppose I have Sheet(1) in an excel. Now i do also have 2500 rows which has data for the columns from A to BO.Now I want the data to copy from these sheet to another sheet of the same Excel file for 2500 rows but not the whole the columns,rather i need only columns from A to AA data to copy to the new sheet.
So how to frame it using VBscript?
Please help me.
How to copy rows of from one sheet to another sheet using vbscript
To copy data from one sheet to another you can use the Copy en PasteSpecial commands. To do this with a .vbs script do the following:
' Create Excel object
Set objExcel = CreateObject("Excel.Application")
' Open the workbook
Set objWorkbook = objExcel.Workbooks.Open _
("C:\myworkbook.xlsx")
' Set to True or False, whatever you like
objExcel.Visible = True
' Select the range on Sheet1 you want to copy
objWorkbook.Worksheets("Sheet1").Range("A1:AA25").Copy
' Paste it on Sheet2, starting at A1
objWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial
' Activate Sheet2 so you can see it actually pasted the data
objWorkbook.Worksheets("Sheet2").Activate
If you want to do this in Excel with a VBS macro you can also call the copy and paste methods. Only your workbook object will be something like ActiveWorkbook
This code is Working fine. Just Copy and paste it.
Dim CopyFrom As Object
Dim CopyTo As Object
Dim CopyThis As Object
Dim xl As Object
xl = CreateObject("Excel.Application")
xl.Visible = False
CopyFrom = xl.Workbooks.Open("E:\EXCEL\From.xls")
CopyTo = xl.Workbooks.Open("E:\EXCEL\To.xls")
For i = 0 To 1
''To use a password: Workbooks.Open Filename:="Filename", Password:="Password"
If i = 0 Then
CopyThis = CopyFrom.Sheets(1)
CopyThis.Copy(After:=CopyTo.Sheets(CopyTo.Sheets.Count))
CopyTo.Sheets(3).Name = "Sheet3"
Else
CopyThis = CopyFrom.Sheets(2)
CopyThis.Copy(After:=CopyTo.Sheets(CopyTo.Sheets.Count))
CopyTo.Sheets(4).Name = "Sheet4"
End If
Next
CopyTo.Sheets(1).Activate()
CopyTo.Save()
'CopyTo.SaveAs("E:\EXCEL\Check.xls")
xl.Quit()
Sub buildMissingSheet(strMissingSheet) 'Just passing the missing sheet name in
' Master Sheet code
' Working on creating the "Master Sheet" at this time...May need to seperate the the code a little.
Dim GetRows1 As Worksheet
Dim GetRows2 As Worksheet
Dim PutRows As Worksheet
Dim sglRowNum As Single, i%
If strMissingSheet = strMASTERSHEET Then ' Create the strMASTERSHEET
Set GetRows1 = Sheets(strRAWDATA) ' These two sheets could be missing but will code around that later.
Set GetRows2 = Sheets(strDATAWITH) ' The two sheets I am getting rows from
' Just creating a new worksheet here assuming it is missing
Worksheets.Add(After:=Worksheets(5)).Name = strMissingSheet
Set PutRows = Sheets(strMissingSheet) ' Missing sheet must be created before declaring.
PutRows.Select 'Select the sheet being built.
With Cells(1, 1)
.Value = strRAWDATA 'Not copying rows here but left it in this example anyway
.AddComment
.Comment.Visible = False
.Select
.Comment.Text Text:= _
Chr(10) & "Name of sheet including header and the last 32 entries at the time this sheet was updated."
End With
'Here is where we copy the whole row from one sheet to the other.
GetRows1.Rows(1).Copy PutRows.Rows(2) 'Copy header row from existing sheet to "Master Sheet" for instance.
GetRows1.Select
sglRowNum = ReturnLastRow(ActiveSheet.Cells) 'return last row with data on active sheet
' I wanted the last few rows of data "32 rows" so found the end of the sheet this code can be found on the internet in several places including this site.
'Now the code you may have been looking for move 32 row of data from one sheet to another.
For i = 1 To 32 'Start at row 3 on the Put sheet after sheet name and header.
GetRows1.Rows(sglRowNum - (32 - i)).Copy PutRows.Rows(i + 2)
Next i
end sub