I think I'd like to do my everyday things easier. I do not have any wide knowleadge of VBA so i use it with "record VBA".
I have 2 workbooks:
(1) "DATABASE.xlsx" - fixed which always collect data
(2) many workbooks i.e. "xxx.xlsx" , "yyyy.xlxs", "zzzz.xlsx" etc. - variable workbook, changing every time depends on what i copy from the workbook (1) - I will open (2) manually by myself
My issue is how to write my VBA to copy data from (1) to various workbooks (2). I do not know how to define the (2) workbooks which alwyas change. I can choose (2) workbooks manually. It does not have to be something really professional. It's only about coping from (1) to (2)....
I have done as below:
Sub Makro10() ' ' Makro10 Makro ' ' Klawisz skrótu: Ctrl+Shift+X '
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 2).Range("A1:H1").Select
Selection.Copy
Windows("xxx.xlsx").Activate
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 8).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("xxx.xlsx").Activate
ActiveCell.Offset(0, 9).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 1).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("xxx.xlsx").Activate
ActiveCell.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 3).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("xxx.xlsx").Activate
ActiveCell.Offset(0, 14).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False End Sub
It's working for only specific (2) workbook "xxx.xlsx", but i would like to use it for various (2).
I'm asking for support, thanks in advance.
The easiest way to achieve this is by replacing all the instances of Windows("xxx.xlsx").Activate with Workbooks(2).Activate in your code.
But you have to make sure that no other workbooks are open as the code can accidentally reference another workbook based on how you opened excel files. So technically, you need to open workbook (1) first which is DATABASE.xlsx. Then open whichever workbook (2) you need and run the code.
Sub Makro10() ' ' Makro10 Makro ' ' Klawisz skrótu: Ctrl+Shift+X '
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 2).Range("A1:H1").Select
Selection.Copy
Workbooks(2).Activate
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 8).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(2).Activate
ActiveCell.Offset(0, 9).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 1).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(2).Activate
ActiveCell.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 3).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(2).Activate
ActiveCell.Offset(0, 14).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False End Sub
What is happening here is that VBA references the 2nd workbook that was opened (which is workbooks(2)) and pastes the data there as per the code. in your earlier code, because you recorded it, it was always using xxx.xlsx file because that is how you recorded it.
I would suggest that if possible save the code in DATABASE.xlsx and save the file as a macro file (DATABASE.xlsm). That way, you can open workbook (1) and workbook (2) (whichever one you want) and run the code from workbook (1).
Hope this helps! Happy coding!
Sub Makro2()
'
' Makro2 Makro
'
' Klawisz skrótu: Ctrl+Shift+X
'
Dim OthWB As String
Windows.Application.ActiveSheet.Select
OthWB = ActiveWorkbook.Name
Workbooks("202102 PO.xlsx").Activate
ActiveCell.Offset(0, 2).Range("A1:H1").Select
Selection.Copy
Workbooks(OthWB).Activate
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("202102 PO.xlsx").Activate
ActiveCell.Offset(0, 8).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(OthWB).Activate
ActiveCell.Offset(0, 9).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("202102 PO.xlsx").Activate
ActiveCell.Offset(0, 1).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(OthWB).Activate
ActiveCell.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("202102 PO.xlsx").Activate
ActiveCell.Offset(0, 3).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(OthWB).Activate
ActiveCell.Offset(0, 14).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
#Bharath Raja
Thanks for your answer. I will try your solution also
I was thinking also about issue & found the resolve. We must active (2) workbook & then it is defined as OthWB. Maybe somebody uses it also.
How do I change the following code to use the same macro for the next row in my spreadsheet: i.e. range("C1360") then "C1361" etc.
ActiveWindow.ActivateNext
Range("C1359").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I'm trying to add a condition to a copy and paste macro where it copies a row from table1 and pastes it onto table2 if the row in table1 is red.
I've tried:
Sub ColdLake1()
If Range("B55").Interior.ColorIndex = 3 Then
Range("B55:H55").Select
Selection.Copy
Range("C140").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
It returns nothing. Any ideas?
Thanks (I'm quite new to all this).
This worked for me:
Sub ColdLake1()
With ActiveSheet
Debug.Print "ColorIndex", .Range("B55").Interior.ColorIndex
If .Range("B55").Interior.ColorIndex = 3 Then
.Range("B55:H55").Copy
With .Range("C140")
.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
End If
End With
End Sub
If your code isn't doing anything it may be because the color isn't what you think it is, or for some reason your code is not entering the If block. Put some breakpoints and see what is going on. https://www.excel-easy.com/vba/examples/debugging.html
im trying to create a code that can help me to paste my formulas in a range.
the range is always changing as i have to include information on a daily basis at the en of my list
the existing code almost gets the job done but6 instead of recognizing the value on cell a1 (a count of the amount of records to calculate) it pastes the information on range e1:k1
Sub Run_Formulas()
'
' Run_Formulas Macro
'
Dim As Variant
x1 As Variant
x1 = Worksheets("Raw Data").Range("A1")
'
Range("E4:K4").Select
Selection.Copy
Range("E8" & ":" & "K" & "a1").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End Sub
how can i get the macro to recognize the contents of cell a1 and to use it for my final range/
I am a starting VBA enthusiast and I would like some help on the below formula as I have no idea how to make sure the formula applies to all rows in the book. As you can see, I have started copying the actual code, but as I have to do this for up to 100 rows this will be too manually.
Thanks
Sub Charts()
' Charts Macro
' Run charts
Range("D7").Value = Range("D11")
Range("E7:G7").Select
Selection.Copy
Range("E11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D7").Value = Range("D12")
Range("E7:G7").Select
Selection.Copy
Range("E12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D7").Value = Range("D13")
Range("E7:G7").Select
Selection.Copy
Range("E13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D7").Value = Range("D14")
Range("E7:G7").Select
Selection.Copy
Range("E14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Is this what you are trying?
Option Explicit
Sub Charts()
Dim i As Long
'~~> Change this to the relevant sheet
With Sheets("Sheet1")
For i = 11 To 14 '<~~ Change 14 to whatever row you want to go to
.Range("D7").Value = .Range("D" & i).Value
.Range("E7:G7").Copy
.Range("E" & i).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
End With
End Sub