VBA code to copy pivot table data and populate a field - vba

i'm trying to write a script that will copy a pivot table and paste the values in another sheet. for some reason, if I don't start the script on the az tracker sheet, the script will copy the (and fill) the wrong range. can you see where the issue lies?
Sub updateazdata()
Dim wbmodel As Excel.Workbook
Set wbmodel = Workbooks("AMS")
Dim col As Long
Dim lastcol As Long
Dim lastrow As Long
Dim rng As Range
Dim azurerng As Range
wbmodel.Sheets("Az order book").PivotTables("Azpivot").PivotSelect "", xlDataandlabels
Set rng = Selection.Offset(2, 0)
rng.Select
Set azrng = wbmodel.Sheets("az Tracker").Range("G4").Resize(rng.Rows.Count, rng.Columns.Count)
azrng.Value = rng.Value
Set azrng = azrng.SpecialCells(xlCellTypeBlanks)
azrng.Select
'azrng.FormulaR1C1 = "=R[-1]C"
End Sub
Thank you for your help!

Related

Trying to copy a range from one sheet and paste it to the next empty cell in a column on another sheet

I am trying to copy a range from one sheet ("H2:H200") or can be Range("H2").End(xlDown) (neither of these works) and paste it to the next empty cell on another cell. (basically putting two columns under each other). I have the following code, but I get "Worksheet Object Failed" error. What am I doing wrong?
Sub Mergescript()
Dim ssaw_p As Worksheet
Dim oqs As Worksheet
Set ssaw_p = Sheets("SSAW_EXPORT")
Set oqs = Sheets("SQL_IMPORT")
ssaw_p.Range("H2:H200").Copy Destination:=oqs.Range("G").End(xlDown).Offset(1, 0)
End Sub
the oqs.range, is not correct try this :
ssaw_p.Range("H2:H200").Copy Destination:=oqs.Range("G1").End(xlDown).Offset(1, 0)
this will copy your ssaw range after the first empty cell in column G
Sub Mergescript()
Dim ssaw_p As Worksheet
Dim oqs As Worksheet
Set ssaw_p = ThisWorkbook.Sheets("SSAW_EXPORT")
Set oqs = ThisWorkbook.Sheets("SQL_IMPORT")
With ssaw_p
.Range("H2:H200").Copy Destination:=oqs.Range("G1").End(xlDown).Offset(1, 0)
End With
End Sub
this works
To avoid trying to go off the end of the sheet (if nothing in G ) use the following.
Option Explicit
Sub Mergescript()
Dim ssaw_p As Worksheet
Dim oqs As Worksheet
Set ssaw_p = Sheets("SSAW_EXPORT")
Set oqs = Sheets("SQL_IMPORT")
Dim lastRow As Long
Dim nextRow As Long
With oqs
lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
End With
If lastRow = 1 Then
nextRow = 1
Else
nextRow = lastRow + 1
End If
ssaw_p.Range("H2:H200").Copy Destination:=oqs.Range("G" & nextRow)
End Sub
Try with
ssaw_p.Range("H2:H" & Range("H2").End(xlDown).Row).Copy oqs.Range("G" & oqs.Range("G2").End(xlDown).Row + 1)
This code will always copy all data in sheet EXPORT Range H2: to last cell in Column H and paste it into the first blank column found in column G on sheet IMPORT

Excel stopped working while using find

I'm Working on a code to find a row which has "1263_Estamp_En" in Range "J1" and wan to select the same column and paste it to another workbook but while running the code excel stop working and restart itself, please help how can I search the range and select the value. Below is the code...
Sub Search()
Dim A As Range
Dim myRng As Range
Dim R As Range
Dim Col
ThisWorkbook.Sheets("Result").Activate
Set R = Range("A1:Z1")
ThisWorkbook.Sheets("Sheet1").Activate
Set A = Range("A1")
myRng = R.Find(what:=Str(A), LookIn:=xlValue)
Cells(myRng.Row, myRng.Column).Select
Col = Selection.Column
Col.select
Range(selection,selection.end(xldown)).copy
Thisworkbook.Sheets("Sheet2").Activate
Range("A1").Pastespecial xlPasteValues
End Sub
I think you are looking for something like the code below (without all the unnecessarily Activate, Selection and Select):
Option Explicit
Sub Search()
Dim A As Range
Dim myRng As Range
Dim R As Range
Dim Col
Set R = Sheets("Result").Range("A1:Z1")
Set A = Sheets("Sheet1").Range("A1")
Set myRng = R.Find(what:=CStr(A.Value), LookIn:=xlValue, lookat:=xlWhole)
If Not myRng Is Nothing Then ' <-- check if Find was successful
' rest of your code goes here
myRng.EntireColumn.Copy <-- copy entire Column where found
Sheets("Sheet2").Range("A1").PasteSpecial xlPasteValues
End If
End Sub

Looping through ranges by columns in different worksheets

I have got a macro that needs to loop according to the number of columns that exist in the Worksheet "NSA" (not counting the dates), as in the image below:
Looping through the columns, the macro needs to fill the corresponding range in the worksheet "SA" with a random number, one column at a time.
I want to fill one column of "SA" for each time the loop occurs in "NSA", as to keep different numbers in B:B and C:C.
Thus, in the first time the code runs, I would like to insert data only in column B and, in the second time, fill only the column C.
That's where my code fails. It always fills both columns B and C in the worksheet "SA" at the same time, each time it runs. This is what I get (for a random value):
How could I change the loop so the columns in "SA" change only one at a time, according to the loop in "NSA"?
Thanks for the help.
Here is my code:
Sub Dessaz2()
Dim wb1 As Workbook
Set wb1 = ActiveWorkbook
Dim wsNSA As Worksheet
Set wsNSA = wb1.Worksheets("NSA")
Dim wsSA As Worksheet
Set wsSA = wb1.Worksheets("SA")
Dim col1 As Range
Dim col2 As Range
LR = wsNSA.Cells(3, 1).End(xlDown).Row
LC = wsNSA.Cells(3, 1).End(xlToRight).Column
For Each col1 In wsNSA.Range(Cells(3, 2), Cells(LR, LC)).Columns
wsNSA.Activate
wsSA.Activate
x = WorksheetFunction.RandBetween(0, 100)
wsSA.Range(Cells(3, 2), Cells(LR, LC)) = x
Next
End Sub
Fill col1.column each time :
Sub Dessaz2()
Dim wb1 As Workbook
Set wb1 = ActiveWorkbook
Dim wsNSA As Worksheet
Set wsNSA = wb1.Worksheets("NSA")
Dim wsSA As Worksheet
Set wsSA = wb1.Worksheets("SA")
Dim col1 As Range
Dim col2 As Range
LR = wsNSA.Cells(3, 1).End(xlDown).Row
LC = wsNSA.Cells(3, 1).End(xlToRight).Column
For Each col1 In wsNSA.Range(wsNSA.Cells(3, 2), wsNSA.Cells(LR, LC)).Columns
wsNSA.Activate
wsSA.Activate
x = WorksheetFunction.RandBetween(0, 100)
wsSA.Range(wsSA.Cells(3, col1.Column), wsSA.Cells(LR, col1.Column)) = x
Next
End Sub
Sub Main()
Dim rng as Range, cl as Range
Set rng = worksheets("NSA").Range("B1:C100") // update for your Range
For each cl in rng
Worksheets("SA").Range(cl.Address) = WorksheetFunction.RandBetween(0, 100)
Next cl
End Sub

Create Table in Excel Worksheet using VBA

I have this code below that will auto select a range.
Does anyone know how I can add code to create a table to the selected range?
Thanks!
Sub DynamicRange()
'Best used when first column has value on last row and first row has a value in the last column
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Sheet1")
Set StartCell = Range("D9")
'Find Last Row and Column
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
'Select Range
sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
End Sub
Use the following Excel VBA code snippet to add the Table object corresponding to selected Range:
Dim objTable As ListObject
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
You can also apply optional styling to the added Table object like shown below:
objTable.TableStyle = "TableStyleMedium2"
More details available at MSDN: https://msdn.microsoft.com/en-us/library/office/ff823155.aspx
Hope this will help.

finding the next empty cell so that it wont overwrite the previous pasted data

I am having a problem to consolidate data from multiple worksheet into a summary worksheet. It is able to copy all the data except when the data is pasted it will overwrite the previous data. Example data in sheet A is pasted to recompile sheet starting from range A2. The problem is data in sheet B,C,D etc will also be pasted starting from range A2 causing it to overwrite each other.
This is my code.
Private Sub CommandButton2_Click()
Dim Sheetname, myrange As String
Dim A, noOfrows As Integer
Dim startRow As Integer
For i = 2 To Worksheets("Master Sheet").Cells.SpecialCells(xlCellTypeLastCell).Row
Sheetname = Worksheets("Master Sheet").Cells(i, 27).Value'All the sheets that suppose to transfer to recompile sheet
noOfrows = Worksheets(Sheetname).Cells.SpecialCells(xlCellTypeLastCell).Row
myrange = "A2:N" & CStr(noOfrows)
Worksheets(Sheetname).Select
Worksheets(Sheetname).Range(myrange).Select
Selection.Copy
Sheets("Recompile").Select
Range("A2").Select
ActiveSheet.Paste
Next i
End Sub
You need to find the UsedRange in the "Recompile" sheet and paste into the range below that:
Something like:
Private Sub CopyData()
Dim A As Long
Dim noOfrows As Long
Dim startRow As Long
Dim i As Long
Dim control As Worksheet
Dim source As Worksheet
Dim target As Worksheet
Set control = Worksheets("Master Sheet")
Set target = Worksheets.Add
For i = 2 To control.UsedRange.Rows.Count
' the target worksheet for this row of data
Set source = Worksheets(control.Cells(i, 1).Value) ' My example has this data in column A
' the address of a range with (number of rows - 1) for columns A:N
source.Range("A2:N" & source.UsedRange.Rows.Count).Copy
target.Range("A" & target.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row).PasteSpecial xlPasteValues
Next i
End Sub
Lots of information and tips here: http://www.rondebruin.nl/win/s3/win002.htm