I am new to excel macro vba please help.... My below code is to transfer data from 1 excel to another. However, when I execute the macro it transfers only 1 row i.e. A2 and B2 cell values into another excel.
My VBA code....
Private Sub CommandButton1_Click()
Dim InvoiceNumber As String
Dim ForwarderCode As String
Dim wb As Workbook
Worksheets("SampleFile").Select
InvoiceNumber = Range("A2")
Worksheets("SampleFile").Select
ForwarderCode = Range("B2")
Set wb = Workbooks.Open("C:DestinationPath.xlsm")
Worksheets("Sheet1").Select
Worksheets("Sheet1").Range("A2").Select
RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Sheet1").Range("A1")
.Offset(RowCount, 0) = InvoiceNumber
.Offset(RowCount, 1) = ForwarderCode
End With
wb.Save
End Sub
Please help it should transfer the entire data present in column A and B....
If you want copying from A1 to C last filled cell, try the next code, please:
Private Sub CommandButton1_Click___()
Dim shSF As Worksheet, sh1 As Worksheet
Dim wb As Workbook, lastRow As Long
Set shSF = Worksheets("SampleFile")
lastRow = shSF.Range("A" & Rows.count).End(xlUp).row
Set wb = Workbooks.Open("C:DestinationPath.xlsm")
Set sh1 = wb.Worksheets("Sheet1")
shSF.Range("A1:C" & lastRow).Copy Destination:=sh1.Range("A1")
wb.Save
End Sub
Related
How do I avoid using select/activate in my macro (to help speed it up)?
The macro goes through each row on a worksheet; if the QTY is greater than zero (in column C), then it calls another macro to open a specific workbook (workbook name in column A), makes some changes and then closes that workbook.
Sub Update_All_Workbooks()
Dim LastRow As Long
Dim DataRange As Range
Dim WB As Workbook
Dim WS As Worksheet
Set WB = ActiveWorkbook
Set WS = ActiveSheet
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set DataRange = Sheets("TestA").Range("A3:A" & LastRow)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
WB.Sheets("TestA").Activate
Range("C3").Select
For Each Row In DataRange
If ActiveCell > 0 Then
Call Open_Update_Close_WB
WB.Sheets("TestA").Activate
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Next Row
WS.Activate
End Sub
Its quite a change in perspective to move from using select to using references but in the long run, code is much better when using references.
I hop the code below is useful to you.
Option Explicit
Sub Update_All_Workbooks()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim myWB As Workbook
Set myWB = ActiveWorkbook
' We set myWS on the basis of the unqualified Cell method used in th original code
Dim myWS As Worksheet
Set myWS = myWB.ActiveSheet
Dim LastRow As Long
LastRow = myWS.Cells(Rows.Count, "A").End(xlUp).Row
' Pull the filenames into a VBA array
' So we don't keep having to refder to a Worksheet
' The transpose method is used to convert the pseudo 2D array
' to a correct 1D array
Dim myWbNames As Variant
Set myWbNames = myWB.Application.WorksheetFunction.Transpose(myWS.Range("A3:A" & LastRow).Value)
' Similar to above, you can extract the QTY values in
' column C to a VBA array
Dim myQTY As Variant
Set myQTY = myWB.Application.WorksheetFunction.Transpose(myWS.Range("C3:C" & LastRow).Value)
' Because we are processing two arrays (col a and col c)
' its easier to use a standard for loop with an index than a for each loop
Dim myIndex As Variant
For myIndex = LBound(myWbNames) To UBound(myWbNames)
If myQTY(myIndex) > 0 Then
Open_Update_Close_WB myWbNames(myIndex)
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
' Underscores have significance in Method names as they are used in
' interface and event declarations
' Therefore it is good practise to get used to NOT using underscores
' for Method names that do not involve an interface
Public Sub OpenUpdateCloseWB(ByVal ipWbName As String)
End Sub
I want to copy the G column from wb1 to the last cell available of column O in wb2, i implemented a macro but it displays the ERROR 6 OVERFLOW.
I think that the cell counting is correct because that's what i want to know, not the whole column but correct me if i'm wrong.
Private Sub C_C(File As String)
Dim Lcopy As Workbook
Dim LDestiny As Workbook
Dim Destiny As Worksheet
'--
Set LDestiny = ActiveWorkbook
Set Destiny = ActiveSheet
Set Lcopy = Workbooks.Open(File)
Sheets("RCC").Range("G2" & Sheets(1).Range("G" & Rows.Count).End(xlUp).row).Copy
MsgBox ("Copied")
Destiny.Range("O").SpecialCells(xlCellTypeLastCell).Column
MsgBox ("Dont do anything")
ActiveWorkbook.Close
End Sub
With LastRow
Private Sub C_C(File As String)
Dim Lcopy As Workbook
Dim LDestiny As Workbook
Dim Destiny As Worksheet
'--
Set LDestiny = ActiveWorkbook
Set Destiny = ActiveSheet
Set Lcopy = Workbooks.Open(File)
Sheets("ReporteCifrasControl").Range("G2" & Sheets(1).Range("G" & Rows.Count).End(xlUp).row).Copy
MsgBox ("Copied")
Destino.Range("O" & Destino.Range("O" & Rows.Count).End(xlUp).row + 1).PasteSpecial xlPasteValues
MsgBox ("Dont do anything")
ActiveWorkbook.Close
End Sub
I am trying to copy specific cells from one workbook to another at the end of the table.
I assume the problem is with using 'ActiveWorkbook' a lot.
I get the error "Object doesnt support this property or method" and it seems that macro copies cells from CurrentBook and not uploader.
How can I fix my code?
Dim uploadfile As Variant
Dim uploader As Workbook
Dim CurrentBook As Workbook
Dim lastRow As Integer
Set CurrentBook = ActiveWorkbook
uploadfile = Application.GetOpenFilename()
If uploadfile = "False" Then
Exit Sub
End If
Workbooks.Open uploadfile
Set uploader = ActiveWorkbook
With uploader
Application.CutCopyMode = False
Range("A1:J100").Copy
End With
CurrentBook.Activate
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & lastRow & ":J" & lastRow + 100).Select
Selection.Paste
uploader.Close
End Sub
In VBA you must not use Ative.
So replace all the Active and you have to use PasteSpecial, it's better than Paste
Sub test()
Dim uploadfile As Variant
Dim uploader As Workbook
Dim CurrentBook As Workbook
Dim lastRow As Integer
Set CurrentBook = ThisWorkbook
uploadfile = Application.GetOpenFilename()
If uploadfile = "False" Then
Exit Sub
End If
Set uploader = Workbooks.Open(uploadfile)
Application.CutCopyMode = False
uploader.Worksheets(1).Range("A1:J100").Copy
lastRow = CurrentBook.Worksheets(1).Cells(CurrentBook.Worksheets(1).Rows.Count, "A").End(xlUp).Row + 1
Range("A" & lastRow & ":J" & (lastRow + 100)).PasteSpecial xlPasteValues
uploader.Close
End Sub
This code works for me,
Your welcome :)
Here, and only because I'm bored at work, the are thousands of posts like this:
Option Explicit
Sub CopyPaste()
Dim uploadfile As String 'not Variant, the filename will be a string
Dim wbCopy As Workbook 'Better than uploader As Workbook you need to declare variables easy to read
Dim wbPaste As Workbook 'same as above
Dim LastRow As Lon 'integer doesn't work (it will be a long delimited to integer) either Byte(0-255) or Long
Set wbPaste = ThisWorkbook 'the workbook containing the code
uploadfile = Application.GetOpenFilename()
If uploadfile = "False" Then
Exit Sub
End If
Set wbCopy = Workbooks.Open(uploadfile) 'declare your paste workbook like this
' Set uploader = ActiveWorkbook this way of referencing a workbook might give you errors, use the above
With wbCopy.Sheets("MySheetName") 'reference always the worksheets, change MySheetName for the actual sheet name
'Application.CutCopyMode = False this is useless here it's emptying the clipboard but below you copy something new
.Range("A1:J100").Copy 'you missed the . on the beginning (when using With you need to use the dot to reference the with)
End With
With wbPaste.Sheets("MySheetName") 'reference always the worksheets, change MySheetName for the actual sheet name
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & LastRow).PasteSpecial xlPasteValues 'when you copy/paste you just need to find the first cell on the paste range, Excel will paste the whole range
End With
Application.CutCopyMode = False 'now you can use this to avoid warning message on closing the copy workbook
wbCopy.Close Savechanges:=False
End Sub
Below you could find a sample code on how to copy from one workbook to another:
Option Explicit
Sub test()
Dim wbSource As Workbook, wbDestination As Workbook
'Set both workbooks by name to avoid conflicts
Set wbSource = Workbooks("Book1")
Set wbDestination = Workbooks("Book2")
'Copy paste only values
wbSource.Worksheets("Sheet1").Range("A1").Copy
wbDestination.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues
End Sub
I'm currently doing VBA project which need to copy from a workbook to another, which the WBookPst is the workbook I firstly open (use) meanwhile WBookCopy is the workbook where I open based on the links where I got by listing all ".xslt" format in a File into my Sheet1 of my first workbook. Here is my code :
Sub SortFiles()
'Set up your variables and turn off screen updating.
'Dim iCounter As Integer
Application.ScreenUpdating = False
'Sort the rows based on the data in column C
Columns("A:C").Sort key1:=Range("C2"), _
order1:=xlDescending, Header:=xlYes
Application.ScreenUpdating = True
Dim WBookCopy As Workbook
Dim WBookPst As Workbook
Dim filePath As String
Dim sheetName As String
Dim sheetCopy As Worksheet
Dim sheetPate As Worksheet
Dim rngCopy As Range
Dim rngPst As Range
filePath = Range("B2").Value
Set WBookCopy = Workbooks.Open(filePath)
Columns(30).Insert
For i = 1 To Sheets.count
Cells(i, 30) = Sheets(i).Name
Next i
sheetName = Range("AD1").Value
Set sheetCopy = WBookCopy.Worksheets(sheetName)
Set rngCopy = sheetCopy.Range("A:AA").Copy
Set WBookPst = ThisWorkbook
Set sheetPaste = WBookPst.Worksheets("Sheet1").Activate
Set rngCopy = sheetPaste.Range("A:AA").Select
ActiveSheet.Paste
End Sub
At Set rngCopy = sheetCopy.Range("A:AA").Copy there's error "Objects required".
What does that mean?
By the way, is how I copy and paste the data between sheets correct?
The issue is that rngCopy is of type range and you can't set it equal to a method (copy). Remove the .Copy and you should be fine. You also don't need to set the worksheet out range to a variable. You could just do one line that says WBookCopy.SheetName.Range("A:AA").Copyand then another line to paste.
As #Wyatt mentioned - your copy\paste syntax is incorrect
Here are 2 ways to do it:
Worksheets("Sheet1").Range("A:AA").Copy
Worksheets("Sheet2").Range("A1").PasteSpecial xlPasteAll
or
Worksheets("Sheet1").Range("A:AA").Copy Destination:=Worksheets("Sheet2").Range("A1")
I am trying to copy all sheets (7 sheets) from workbook1(wb1) to wb2. wb1 contains command buttons but I don't want them in my new workbook. I am using loop to copy individual sheets from one workbook to another. but error comes while copying to 2nd sheet. I am using the code as below :-
Public Sub CommandButton1_Click()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim i As Integer
i = 1
Set wb1 = ActiveWorkbook
Set ws1 = ActiveSheet
Set wb2 = Workbooks.Add
With wb2
.Title = "My Sales"
.Subject = "Sales"
.SaveAs Filename:="mysales.xls"
End With
For i = 1 To 7
Dim row As Long
Dim column As Long
wb1.Activate
wb1.Sheets(i).Activate
column = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).column
row = ActiveSheet.Range("A" & Rows.Count).End(xlUp).row
Application.CutCopyMode = False
ActiveSheet.Range(Cells(1, 1), Cells(row, column)).Select
Selection.Copy
wb2.Sheets(i).Range("A1").PasteSpecial
Application.CutCopyMode = False
next i
End Sub
Loop is running succesfully for the first time but for i=2, code gives error
Sub M_snb()
thisworkbook.sheets(array("one","two","three","four","five","six","seven")).copy
do until activeworkbook.sheets("one").oleobjects.count=0
activeworkbook.sheets("one").oleobjects(1).delete
loop
activeworkbook.saveas "G:\OF\new.xlsx",51
End Sub