I am trying to transfer data from one workbook to another. Workbook A has 48 tabs of different data and I have 48 excel files that I need to copy-paste to specific columns. the tab name and file names are matching so that is why I set the names range. I keep getting syntax error from the open statement (set y)
and another error at the ws1-select-range line. would you help me to under stand what I am doing wrong?
Sub Transfer()
Dim x As Workbook, y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim names As String
Set x = ThisWorkbook
For a = 2 To 49
names = ThisWorkbook.Sheets(1).Range("A" & a).Text
' getting compile error: Expected end of statement
set y = workbook.Open Filename:=Thisworkbook.Path & "/" & names & ".xlsx"
Set ws1 = x.Sheets(names)
Set ws2 = y.Sheets("Equipment")
'updated code as below then getting run time error '1004': Copy method of range class failed
ws1.Range("B2:B200").Copy ws2.Range("A3")
ws1.Range("c2:c200").Copy ws2.Range("B3")
ws1.Range("f2:f200").Copy ws2.Range("C3")
ws1.Range("g2:g200").Copy ws2.Range("D3")
Next a
End Sub
I appreciate your time and advice.
So I updated some code and I kind of make it work. :)
Sub Transfer()
Dim x As Workbook, y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim names As String
Dim lastrow As Integer
Dim a As Integer
Set x = ThisWorkbook
For a = 2 To 49
names = ThisWorkbook.Sheets(1).Range("A" & a).Text
Set y = Workbooks.Open("C:\Documents\Work\" & names & ".xlsx")
Set ws1 = x.Sheets(names)
Set ws2 = y.Sheets(2)
lastrow = ws1.Cells(Rows.Count, 6).End(xlUp).Row
ws1.Range("B2:B" & lastrow).Copy ws2.Range("A3")
ws1.Range("C2:C" & lastrow).Copy ws2.Range("B3")
ws1.Range("F2:F" & lastrow).Copy ws2.Range("C3")
ws1.Range("G2:G" & lastrow).Copy ws2.Range("D3")
ws1.Range("H2:H" & lastrow).Copy ws2.Range("E3")
ws1.Range("I2:I" & lastrow).Copy ws2.Range("F3")
ws1.Range("J2:J" & lastrow).Copy ws2.Range("G3")
ws1.Range("L2:L" & lastrow).Copy ws2.Range("H3")
ws1.Range("M2:M" & lastrow).Copy ws2.Range("I3")
ws1.Range("N2:N" & lastrow).Copy ws2.Range("J3")
ws1.Range("O2:O" & lastrow).Copy ws2.Range("K3")
y.Save
y.Close
Next a
End Sub
Related
I have a script which creates a copy of a worksheet with data on it, queries new data, and then uses a lookup (SUMIFS in this case) to pull any manual entries from the old sheet onto the new. I am getting an application-defined/object-defined error message on the line that drops the formula onto the page (the last line below). I attempted adding the formula directly instead, using .Cells, etc., but it must be in the language of the formula itself because I can drop a direct formula in this way (e.g. .Range("N2:N" & LastRow) = "=M2*H2")
Dim CopySheet As String
Dim QSheet As String
Dim FormulaS As String
Dim LastRow As Integer
Dim CoreWB As Workbook
Set CoreWB = ActiveWorkbook
QSheet = "QData"
CopySheet = Format(Date, "mm-dd-yy")
With CoreWB
.Sheets.Add(After:=.Sheets("HistSum")).Name = CopySheet
.Sheets(QSheet).Cells.Copy _
Destination:=Sheets(CopySheet).Cells
End With
FormulaS = "=SUMIFS(" + CopySheet + "!M:M," + CopySheet + "!A:A, A:A," + CopySheet + "!C:C, C:C," + CopySheet + "!J:J, J:J," + CopySheet + ",!E:E, E:E)"
With Sheets(QSheet)
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M2:M" & LastRow).Formula = FormulaS
Try
LastRow should be > 1
Use Long rather than Integer
There was a typo "," at the end
Add ' before and after sheet name
Concatenate with & (as per comments)
Use Worksheets collection
I think you can just post to destination Worksheets(CopySheet).Range("A1") - but I could be wrong.
Code:
Option Explicit
Sub TEST()
Dim CopySheet As String
Dim QSheet As String
Dim FormulaS As String
Dim LastRow As Long
Dim CoreWB As Workbook
Set CoreWB = ActiveWorkbook
QSheet = "QData"
CopySheet = Format$(Date, "mm-dd-yy")
With CoreWB
.Sheets.Add(After:=.Worksheets("HistSum")).Name = CopySheet
.Sheets(QSheet).Cells.Copy _
Destination:=Worksheets(CopySheet).Cells
End With
FormulaS = "=SUMIFS(" & "'" & CopySheet & "'!M:M,'" & CopySheet & "'!A:A, A:A,'" & CopySheet & "'!C:C, C:C,'" & CopySheet & "'!J:J, J:J,'" & CopySheet & "'!E:E, E:E)"
With Worksheets(QSheet)
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
' LastRow > 1
.Range("M2:M" & LastRow).Formula = FormulaS
End With
End Sub
I have two workbooks, source workbook and a Destination workbook.
I would like to copy particular column (A,C;D;E;F;G;K;AP;AV;AW;AX)containing data from source workbook to the Destination workbook in column (A till E). I already searched through the page and could find a code like below
Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim Value As Variant
Set y = ThisWorkbook
Set x = Workbooks.Open("D:\data\Jenny_Work.xlsx")
Value = x.Sheets("Work_Jenny").Range("A1").Value
y.Sheets("Sheet1").Range("A1").Value = Value
x.Close
End Sub
It would be great if you can suggest me for the above criteria
Thanking in advance
try this
it is working for me!
Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim Value As Variant
Set y = ThisWorkbook
Set x = Workbooks.Open("G:\Book1.xlsm")
lRow = x.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
dRow = y.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Union(y.Worksheets("Sheet1").Range("A1:A" & dRow), y.Worksheets("Sheet1").Range("B1:B" & dRow)).Copy
x.Worksheets("Sheet1").Range("A" & lRow).PasteSpecial xlPasteAll
Application.CutCopyMode = False
x.Save
End Sub
Please note that a sheet is not the same as a workbook as this will create confusion.
A workbook/excel file can contain multiple sheets/worksheets and not the other way around.
That being said here is your code:
Sub RunMe()
Dim lRow, lCol As Integer
Sheets("Master").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
For Each cell In Range(Cells(1, "B"), Cells(1, lCol))
Union(Range("A1:A" & lRow), Range(Cells(1, cell.Column), Cells(lRow, cell.Column))).Copy
Workbooks.Add
Range("A1").PasteSpecial
ActiveWorkbook.SaveAs Filename:= _
"C:\YourMap\" & cell.Value & ".xls" 'You might want to change the extension (.xls) according to your excel version
ActiveWorkbook.Close
Next cell
Application.CutCopyMode = False
End Sub
Just watch the file extension within the code (look for green text after pasting.).
I am attempting to copy column A starting in row 2 on "Sheet1" and paste it in Column C on sheet "ABC" starting at row 5. The number of rows in Column A is variable so I cannot use a fixed range.
The code below does what I need, but I am trying to avoid using .Select and .Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet1").Range("A2:A" & LastRow).Copy
Sheets("ABC").Activate
Sheets("ABC").Range("C5:C" & LastRow).Select
Selection.PasteSpecial xlPasteValues
I tried setting the columns equal to one another using this code:
Sheets("ABC").Range("C5").End(xlDown).Value=Sheets("Sheet1").Range("A2:A" & LastRow).Value
This runs without error but it "does nothing" -- No data appears on worksheet "ABC"
I also tried to following:
Dim WS As Worksheet
Dim wsABC As worksheet
Set WS = Sheets("Sheet1")
Set wsABC = Sheets("ABC")
LastRow = Range("A" & Rows.Count).End(xlUp).Row
WS.Range("A2:A" & LastRow).Copy
wsABC.Range("C5").End(xlDown).Paste
This produces a "Run-time error #438 Object doesn't support this property or method" Error on this line:
wsABC.Range("C5").End(xlDown).Paste
Another method I tried was as follows:
Dim WS As Worksheet
Set WS = Sheets("Sheet1")
Set wsABC = Sheets("ABC")
With WS
LastRow = Range("A" & Rows.Count).End(xlUp).Row
WS.Range("A2:A" & LastRow).value = wsABC.Range("C5:C & LastRow").Value
End With
This produces a "Run-time error '1004' Application-defined or object defined error.
I am open to corrections / comments on any of my attempts, I just want to avoid using .Select and .Activate.
Thank you in advance for your time and assistance!
Coding styles can vary greatly. Here's one way to do what you're looking for:
Sub tgr()
Dim wb As Workbook
Dim wsData As Worksheet
Dim wsDest As Worksheet
Set wb = ActiveWorkbook
Set wsData = wb.Sheets("Sheet1")
Set wsDest = wb.Sheets("ABC")
With wsData.Range("A2", wsData.Cells(wsData.Rows.Count, "A").End(xlUp))
wsDest.Range("C5").Resize(.Rows.Count).Value = .Value
End With
End Sub
With Worksheets("Sheet 1")
With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
Worksheets("ABC").Range("C5").Resize(.Rows.Count).Value = .Value
End With
End With
I have the below code, which works fine but it is copying the formulas and cell formatting not just the values. could anyone tell me how to obtain just the values?
Option Explicit
Sub MoveQuick()
Dim sh As Worksheet
Dim ws As Worksheet
Set sh = Sheets("Sheet1")
Set ws = Sheets("Sheet2")
ws.[a2:o2000].ClearContents
sh.Range("B8", sh.Range("S" & Rows.Count).End(xlUp)).AutoFilter 1, "MTU"
sh.Range("D9", sh.Range("I" & Rows.Count).End(xlUp)).Copy ws.Range("A" & Rows.Count).End(xlUp)(2)
sh.Range("T9", sh.Range("V" & Rows.Count).End(xlUp)).Copy ws.Range("H" & Rows.Count).End(xlUp)(2)
sh.[B8].AutoFilter
End Sub
This code will work for you.
sh.Range("D9", sh.Range("I" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
ws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
I have built a code that performs a sumif on another workbook that I open using the get open filename dialogue box. I intend to use this formula daily, and hence the workbook where I intend to obtain the information and the workbook where I intend to paste the results will continue to have varying names basing on the date of the day.
I get a type mismatch on the SUMIF formula. Please help.
Sub flextab()
Dim LastCol As Integer, LastRow As Long
' Get the dimensions
With Sheets("Flex")
LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
End With
'Insert a column where required.
Cells(2, LastCol - 1).EntireColumn.Insert
'Insert the date
Cells(2, LastCol - 1).Value = Date - 1
'Insert the balance sheet balances for the day
Dim wb1 As Workbook, wb2 As Workbook
Dim FileName1 As String, FileName2 As String
Dim BalSheet As Worksheet
Dim Ret1
FileName1 = ThisWorkbook.Name
'~~> Get the first File
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select the Balance sheet for the day")
If Ret1 = False Then Exit Sub
Set wb2 = Workbooks.Open(Ret1)
FileName2 = wb2.Name
Workbooks(FileName1).Activate
'let's get a reference to the worksheet with the source values
Set BalSheet = Workbooks(FileName2).Worksheets("Sheet1")
With Worksheets("Flex").Range(Cells(5, LastCol - 1), Cells(109, LastCol - 1))
'let's put in our SUMIF formulas
.Formula = "=SUMIF(" & BalSheet.Range("B2:B20000") & "," & Worksheets("Flex").Range("A5") & " , " & BalSheet.Range("n2:n20000") & ")"
'let's convert the formulas into values
.Value = .Value
End With
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wb1 = Nothing
End Sub
You are adding ranges to a string, while ranges are objects. Try this:
"=SUMIF(" & BalSheet.Range("B2:B20000").Address & "," & Worksheets("Flex").Range("A5").Value & " , " & BalSheet.Range("n2:n20000").Address & ")"
instead of this:
"=SUMIF(" & BalSheet.Range("B2:B20000") & "," & worksheets("Flex").Range("A5") & " , " & BalSheet.Range("n2:n20000") & ")"
You are working with 2 workbooks, but you are using some worksheets without qualifier.
If you have focus to the wrong workbook this will fail if the workbook that is active does not have a Flex worksheet.
So change this:
Worksheets("Flex").Range(Cells(5, LastCol - 1)
to this:
wbX.Worksheets("Flex").Range(Cells(5, LastCol - 1)
where the X is the correct workbook.