I'm trying to copy contents from several sheets to a final sheet (let's call it "Report" sheet), where the content of a sheet is copied starting on the first free row after the content of the previous sheet.
I'm using a for cycle to go to each sheet and copy the range that I need and paste it to the Report sheet, but I'm getting:
Run-time error 1004: "Application-defined or object-defined error"
I already tried changing how to copy/paste the contents, but it still didn't work (copy and paste special; destination range.value = source range.value; select; ...).
Do you have an idea of what's going on?
Thanks in advance for your help!
Sub final_data()
Dim list_end, last_line, h, first_line_range, last_line_range As Integer
Dim sht_qty As Integer
h = 1
i = 2
list_end = 1
sht_qty = Application.Sheets.Count
For h = 1 To sht_qty
If Workbooks("Testes2").Sheets(h).Name <> "Report" Then
last_line = Workbooks("Testes2").Sheets(h).Range("A1").End(xlDown).Row
first_line_range = list_end + 1
last_line_range = last_line + list_end - 1
'the error is on the next line
Workbooks("Testes2").Sheets(h).Range("A2:I" & last_line).Copy Destination:=Workbooks("Testes2").Sheets("Report").Range("A" & first_line_range & "I" & last_line_range)
Else
End If
Next h
End Sub
Just change your destination to this:
Destination:=Workbooks("Testes2").Sheets("Report").Range("A" & first_line_range)
and that should work
Related
I'm trying to write a VBA procedure to replace all #REF text in formulas with text from the first column of the worksheet which are also names of other sheets.
Each line has formulas from C to BC and the text from the first column varies by line.
The procedure works great for the first 4 rows and no matter what I do to the loop parameter, it will throw 1004 error (application-defined or object-defined error) on the 5th line.
PS.: First row of data is row 4, so the exception occurs when the loop reaches row 9.
I'd be glad to give more details if needed.
Sub Formulas()
Dim m As Integer, pts As Worksheet, formstr As String
Set pts = Sheets("Pontos")
m = Application.WorksheetFunction.CountIf(pts.Range("A5:A30"), "*") + 5
For i = 5 To m
For Each c In pts.Range("C" & i & ":BC" & i).Cells
formstr = c.Formula
formstr = Replace(formstr, "#REF", "'" & Cells(i, 1) & "'", , , vbTextCompare)
c.Formula = formstr
Next
Next i
End Sub
I've tried different forms of loops and mess with i and whenever it's > 9 there will be an error.
I'm having an issue with my For If statement. The scenario is that, I need the empty cells to be filled with a telephone number. I have made a code and it works but at some point it will stop in between. Sometimes all the way to the end of the last row or just skip a few cells and continue again. I'm really not sure about this weird issue, hopefully someone can give me an insight. I have also attached a snapshot of the results.
My code is as shown below:-
Dim pn As Range
Dim h As Integer, phone As Integer
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Set pn = Range("AE2:AE" & lastrow)
h = 1
For phone = 1 To pn.Rows.Count
If pn.Cells(h) = "" Then
pn.Cells(h) = "03-33422828"
Else
h = h + 1
End If
Next
An alternative way to do this is to select all the used cells in that range, then fill all the blank ones with a value.
For example, if we have a workbook with data in column A and we want to fill the blank cells in that column with "---" we could do this:
On Error Resume Next
Range("A1:A" & ActiveSheet.UsedRange.Rows.Count). _
SpecialCells(xlCellTypeBlanks).Value = "---"
On Error GoTo 0
VBA will generate an error if there are no blank cells, so I've "handled" that by just ignoring any errors.
For you it would be more like:
On Error Resume Next
Range("AE1:AE" & ActiveSheet.UsedRange.Rows.Count). _
SpecialCells(xlCellTypeBlanks).Value = "03-33422828"
On Error GoTo 0
I have two workbooks. One workbook has the calendar dates(Calendar.xlsm) and the other workbook has only the names(Workingdays.xlsm) of my class students. What i'm trying to do is to match the names in Workingdays.xlsm to Calendar.xlsx . If the match is found then copy the entire row (last filled cell) to Workingdays.xlsm.
So far i'm successful in matching the names in the two workbooks but unable to select the entire row for that matched names.
Sub Obtain_days()
' Open Calendar
Dim calendar_wb As Workbook
Dim calendar_ws As Worksheet
Dim Workdays_ws As Worksheet
Set calendar_wb = Workbooks.Open("C:\Users\XXX1\Desktop\Calendar.xlsx")
Set calendar_ws = calendar_wb.Worksheets("Sheet1")
Set Workdays_ws = Workbooks("Workingdays.xlsm").Worksheets("Sheet1")
' obtain dates
Workdays_ws.Activate
last_rw_Workdays = Workdays_ws.Range("A1000000").End(xlUp).Row
last_rw_calendar = calendar_ws.Range("A1000000").End(xlUp).Row
'last_col_calendar = calendar_ws.Range("XFD3").End(xlToLeft).Column
' loop through names <-------------Sucessful in matching names
For i = 3 To last_rw_Workdays
findval = Workdays_ws.Range("A" & i).Value
For j = 5 To last_rw_calendar
If calendar_ws.Range("A" & j).Value = findval Then
'calendar_ws.Range("C" & last_col_calendar).Copy
calendar_ws.Cells(j, 32).Resize(1, 25).Copy Destination:=Workdays_ws.Cells(i, 3).Resize(1, 2) '<---failed in this step, copying irrelevant cell reference
'ActiveSheet.Range((last_rw_calendar, 1),(last_rw_calendar, last_col_calendar)).Copy
Workdays_ws.Activate
'Workdays_ws.Range("B1000000").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next j
Next i
End Sub
Failed to copy the entire row (Till last filed cell). Any help would be much appreciated
Without more details, I believe you actually want:
calendar_ws.Cells(j, 1).Resize(1, 25).Copy Destination:=Workdays_ws.Cells(i, 3)
This is assuming the "calendar_ws" row has 25 columns you want to copy over to "Workdays_ws" starting in column "C".
I am trying to do simple copy paste task of a range. I am looking for a match of header in two excel sheets and when match occur I am trying to copy that column except 1st row to the different excel with same sheet name. I am able to copy paste complete column but I don't want to copy 1st row which is header.
Please advice
Set Wb1 = Workbooks(Wb1name)
Sheetname = Wb1.ActiveSheet.Name
Set Wb2 = Workbooks("Worksheet2.xlsm")
'Find the last non-blank cell in row 1
l1Col = Wb1.Worksheets(Sheetname).Cells(1, Columns.Count).End(xlToLeft).Column
l1Row = Wb1.Worksheets(Sheetname).Cells(Rows.Count, 1).End(xlUp).Row
l2Col = Wb2.Worksheets(Sheetname).Cells(1, Columns.Count).End(xlToLeft).Column
l2Row = Wb2.Worksheets(Sheetname).Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To l1Col
For j = 1 To l2Col
If " " & Wb1.Worksheets(Sheetname).Cells(1, i).Value = Wb2.Worksheets(Sheetname).Cells(1, j).Value Then
'''If header matches in both excels then copy column to destination excel'''
'This is working but entire column copied
Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Columns(i)
'' This dosent work
'Wb2.Worksheets(Sheetname).Range(Cells(2, j), Cells(l2Row, j)).Copy Destination:=Wb1.Worksheets(Sheetname).Range(Cells(2, i), Cells(l1Row, i))
End If
Next j
Next i
You must paste to a Cell/Range and since you are copying a whole column, you must paste it on the first row of the target column.
Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Cells(1, i)
Change:
Wb2.Worksheets(Sheetname).Columns(j).Copy Destination:=Wb1.Worksheets(Sheetname).Columns(i)
To:
Wb2.Worksheets(Sheetname).Range(Chr(j + 64) & "2:" & Chr(j + 64) & Wb2.Cells(Wb2.Rows.Count, "C").End(xlUp).Row).Copy Destination:=Wb1.Worksheets(Sheetname).Range(Chr(i + 64) & "2")
I need some help in writing a code in VBA. I thought I had a pretty good grasp of it, but apparently not.
I have two worksheets in a workbook, "Data" and "Results". "Data" has contents in E2 through E580, but this could change +/-. "Results" has contents in C10 that needs to be copied into D2 and down the column, but only if there is contents in "Data" (E2:E580). Here is what I have so far:
Worksheets("Data").If (Range("E2:E580") = " ", Copy.Worksheets("Results").Range("C10") AND Paste.Worksheets("Data").Range("D2:D580"), False)
Getting Compile Error:
Expected =
Thanks for your help in advance.
Sub copy_data()
Dim i As Integer
For i = 2 To Sheets("Data").Cells(Rows.Count, "E").End(xlUp).Row
If Sheets("Data").Cells(i, 5) <> "" Then
Sheets("Results").Cells(i, 4) = Sheets("Results").Range("C10")
Else
Sheets("Results").Cells(i, 4) = ""
End If
Next i
End Sub
Explanation: Loop through column E in "Data" down to the last entry and copy content from C10 in "Results" into column D if there is a value in the corresponding cell in "Data". If there is no value enter an empty string