recorded macro gives runtime error 5 - vba

I'm new with VBA.
I recorded a macro an d wanted to edit it. after recording it, I wanted to run it one time. But when I did, it returned the Runtime Error 5.
The Macro should take and from a sheet and add it into a pivottable in another sheet.
So this is the code, where the error is based.
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"sourcetable!R1C1:R1048576C21", Version:=xlPivotTableVersion14). _
CreatePivotTable TableDestination:="Tabelle2!R3C1", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion14
thanks for your help

no it doesn't it's a new sheet only for this pivot #SiddharthRout – beginner 4 mins ago
The simplest way to do is
With ActiveWorkbook
.Sheets("Tabelle2").Cells.Clear
.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"sourcetable!R1C1:R1048576C21", Version:=xlPivotTableVersion14). _
CreatePivotTable TableDestination:="Tabelle2!R3C1", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion14
End With
Also I noticed that you have source data defined till the row 1048576. Why so? A more perfect way would be to find the last row and then construct your range. For example
Sub Sample()
Dim lRow As Long
With ActiveWorkbook
'~~> Find last row in sheet sourcetable
With .Sheets("sourcetable")
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lRow = 1
End If
End With
.Sheets("Tabelle2").Cells.Clear
.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:="sourcetable!R1C1:R" & _
lRow & _
"C21", _
Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Tabelle2!R3C1", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion14
End With
End Sub

First: does sourcetable and Tabelle2 worksheets exist?
Then, try it removing all optional meaningless arguments:
ActiveWorkbook.PivotCaches.Create(xlDatabase, "sourcetable!R1C1:R1048576C21") _
.CreatePivotTable ActiveWorkbook.Worksheets("Tabelle2").Range("R3C1")

Related

Why am I unable to update Listbox's RowSource property using excel VBA?

What my userform looks like with the properties window:
This is my code:
With Worksheets("List of Accounts").ListObjects("ListofAccounts").ListColumns(1).Range
Total_rows_Accounts = .Find(What:="*", _
After:=.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
If Total_rows_Accounts > 1 Then
lbxCurrent.RowSource = "List of Accounts!A2:A4"
End If
What my worksheet looks like:
The error:
Your Range is incorrect. It should be lbxCurrent.RowSource = "'List of Accounts'!A2:A4" You're getting the error due to spaces in your sheet name

copy sheet content to another sheet

I want to copy the content of one sheet at the end of the other, i have tried this vba code and it works,
Private Sub CommandButton1_Click()
Sheets("B").Select
Range("A1:H14").Select
Range("A1:H14").Copy
Sheets("A").Select
' Find the last row of data
Range("B48:I48").Select
ActiveSheet.Paste
Sheets("A").Select
End Sub
but what i want is to copy without having to specify the range of the data, because i have many files and many data and it's gonna be hard to do all of that manually and change the range a each time.
Below will copy entire content in Sheet B to Sheet A
Sheets("B").Cells.Copy Destination:=Sheets("A").Range("A1")
You do not need to select cells while copying.
There's no need to use so many Select, which slows down the code, you can use the 1 line below will copy the entire contents of Sheet("B") to the first empty row at Column "A" in Sheet("A").
Dim Rng As Range
Dim lRow As Long
Dim lCol As Long
Dim lPasteRow As Long
With Sheets("B")
lRow = .Cells.Find(What:="*", _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lCol = .Cells.Find(What:="*", _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
lPasteRow = Sheets("A").Cells.Find(What:="*", _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
.Range(.Cells(1, 1), .Cells(lRow, lCol)).Copy Destination:=Sheets("A").Range("A" & lPasteRow + 1)
End With
I usually do something like this, assuming sheet1 is the sheet to be updated by data from sheet2;
dim destLen as Long 'rows used in sheet 1
dim sourceLen as Long 'rows used in sheet 2
Open directory with source files and loop through each file and do the following
destLen = Sheet1.Range("A"&Rows.Count).End(xlUp).Row
sourceLen = Sheet2.Range("A"&Rows.Count).End(xlUp).Row
Sheet2.Range("B1" & ":I" & sourceLen).copy
Sheet1.Range("A" & destLen + 1).pasteSpecial xlValues
Application.CutCopyMode = False

Searching and Selecting multiple data in Worksheets w/ common header

I just started using VBA for making my life easier, programming is not my background at all. When I run codes I may write too much.
So I have two questions, check the code below.
Sub Find()
'
' Find Macro
'
'
'L.NAM.O
Worksheets("LAC").Select
Cells.Select
Selection.Find(What:="forecast_quarter", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("NewForecast").Select
Range("K2").Select
ActiveSheet.Paste
'L.NAM.M
Worksheets("EMEA").Select
Cells.Select
Selection.Find(What:="forecast_quarter", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("NewForecast").Select
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
I want to be able to find the forecast_quarter in both sheets(I have 3 in total) and paste in one Worksheet(New Forecast), one below other. The thing is, I think this is too much, might have an easier way than run all the process all over again.
My idea would be, "search the forecast_quarter quarter in the worksheets I want and paste on below the other). As I have all criterias to do that, this could me massive. Any easier, better way to run it?
Thanks!
Something like this (untested) should work.
Sub CopyAll()
CopyDataByHeader "LAC", "forecast_quarter"
CopyDataByHeader "EMEA", "forecast_quarter"
End Sub
'Look for a specific header on a sheet, and if found copy
' the data below it to "NewForecast" sheet
Sub CopyDataByHeader(shtName As String, hdrText As String)
Dim f As Range
With ActiveWorkbook.Sheets(shtName)
'search for the header
Set f = .Cells.Find(What:=hdrText, After:=.Cells(1), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then
'found the header: copy the data below it
.Range(f.Offset(1, 0), .Cells(.Rows.Count, f.Column).End(xlUp)).Copy _
ActiveWorkbook.Sheets("NewForecast").Cells( _
Rows.Count, "K").End(xlUp).Offset(1, 0)
Else
'header not found...
MsgBox "Header text '" & hdrText & "' not found on sheet '" & shtName & "' !"
End If
End With
End Sub

Excel vba paste on last row of data

i need some code modifications here, on paste command on vba, but the thing is it will paste on the last row of data
im using this code, and this work perfectly but when im try to copy another data it replace the current one
Range(Range("A2:L2" & lastrow), ActiveCell.End(xlDown)).PasteSpecial
change line as
Range(Range("A2:L2" & lastrow), ActiveCell.End(xlDown)).offset(1,0).PasteSpecial
Try using .Insert
Sub Macro2()
Rows("6:6").Copy
Rows("15:15").Insert Shift:=xlDown
End Sub
First of all, your one line of code isn't very much help and the copy line should be there too...
Then :
Range(Range("A2:L2" & lastrow), ActiveCell.End(xlDown)).PasteSpecial
There is no need to select a range of cells if you copied a range to paste, just the first cell where you want to paste!
So the most important part is the copy!
Your code should look something like this :
With ThisWorkBook.Sheets("SheetToCopy")
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
LastRow = 1
End If
.Range("A2:L" & LastRow).Copy
End With
With ThisWorkBook.Sheets("SheetToPaste")
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
LastRow = 1
End If
.Range("A" & LastRow + 1).PasteSpecial
End With

Replace worksheet name within the function in VBA in case of loop

I am creating several worksheets based on some worksheet format just simply copying all its content with formulas. Only I give a new name to the sheet.
I want that each time I create a sheet and giving it a name, format! word in all cells must be replaced with active worksheet name.
I tried to write some codes but it seems not working.
Sub createsheet()
LastRow = Sheets("SUMMARY").Range("A" & Rows.Count).End(xlUp).Row
Dim ws As Worksheet
For i = 9 To LastRow
Set ws = ThisWorkbook.Sheets.Add(after:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = Left(Sheets("SUMMARY").Cells(i, 1), 31)
wsrepl = Worksheets(Worksheets.Count).Name
Sheets("format").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Worksheets(Worksheets.Count).Activate
ActiveSheet.Paste
ActiveSheet.Cells(2, 2) = Sheets("SUMMARY").Cells(i, 1)
ActiveSheet.Cells(5, 2) = Sheets("SUMMARY").Cells(i, 1)
Worksheets(Worksheets.Count).Activate
Cells.Replace What:="format!", Replacement:= _
wsrepl, LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next i
End Sub
Any help will be highly appreciated.
Cells.Replace What:="format!", Replacement:= _
"'" & wsrepl & "'" & "!", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
I found an answer.