Attaching a Path to a userform selection - excel

I have a workbook in E:\EXPENCES. In it, a Userform with 2 comboboxes.
cmb1 lists names of workbooks that are in a different folder (E:\MLDOWNLOADS) - The Target.
cmb2 lists Sheets in the current workbook - The Destination.
I would like to copy a range from Target and paste into the destination.
How do I assign a variable that contains full path of target attached to cmb1.value
current code:
Dim cbook As Workbook
Dim psheet As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim Dpath As String
Dpath = "E:\MLDOWNLOADS\"
cbook = (Dpath & Frmdownloads.cmb1.Value)
psheet = Frmdownloads.cmb2.Value
Set wsCopy = Workbooks(cbook).Worksheets("List transactions")
Set wsDest = ThisWorkbook.Worksheets(psheet)
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("A2:D" & lCopyLastRow).Copy wsDest.Range("A" & lDestLastRow)
End Sub

Related

How to copy multiple worksheets to another workbook?

I am trying to copy data from multiple worksheets to another workbook using a loop.
The code breaks when it gets to
Set wsCopy = Workbooks("acex_resultsv1.xlsm").Worksheets(i)
Public Sub Update_Dashboard()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim i As Integer
i = 1
Do While i <= Worksheets.Count
Worksheets(i).Select
Set wsCopy = Workbooks("acex_resultsv1.xlsm").Worksheets(i)
Set wsDest = Workbooks("acex_results.xlsm").Worksheets(i + 1)
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsDest.Range("A2:BI" & lDestLastRow).ClearContents
wsCopy.Range("A2:BI" & lCopyLastRow).Copy _
wsDest.Range("A2")
ActiveCell.Offset(1, 0).Select
i = i + 1
Loop
Worksheets("Dashboard").Select
End Sub
Untested:
Public Sub Update_Dashboard()
Dim wbCopy As Workbook, wsCopy As Worksheet
Dim wbDest As Workbook, wsDest As Worksheet
Dim lCopyLastRow As Long, lDestLastRow As Long, i As Long
Set wbCopy = Workbooks("acex_resultsv1.xlsm")
Set wbDest = Workbooks("acex_results.xlsm") 'ThisWorkbook?
For i = 1 To wbCopy.Worksheets.Count
Set wsCopy = wbCopy.Worksheets(i)
Set wsDest = wbDest.Worksheets(i + 1)
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).row
wsDest.Range("A2:BI" & lDestLastRow).ClearContents
wsCopy.Range("A2:BI" & lCopyLastRow).Copy wsDest.Range("A2")
Next i
wbDest.Worksheets("Dashboard").Select
End Sub
I'm with Tim. Declare variables for source and destination workbooks, Worksheets.Count should be the count worksheets in wbSource.
Also note there is no reason to .Select anything in this process. It only hogs memory.

Transpose data that will be added to an archive sheet

So I've used VBA to take store and use data when an event (button press) occurs. I need to copy in the raw data vertically but have it copy to the archive horizontally so I can better filter it.
Private Sub CommandButton1_Click()
Dim Data As Range
Set Data = Range("C2:C21")
ThisWorkbook.Worksheets("Input").Range("C2:C21").Copy
ThisWorkbook.Worksheets("Calculator").Range("C2:C21").PasteSpecial Paste:=xlPasteValues
Dim dataInput As Worksheet
Dim dataArchive As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Set dataInput = ThisWorkbook.Worksheets("Input")
Set dataArchive = ThisWorkbook.Worksheets("Archive")
lCopyLastRow = dataInput.Cells(dataInput.Rows.Count, "A").End(xlUp).Row
lDestLastRow = dataArchive.Cells(dataArchive.Rows.Count, "A").End(xlUp).Offset(1).Row
dataInput.Range("C2:C21" & lCopyLastRow).Copy _
dataArchive.Range("A" & lDestLastRow)
End Sub
Private Sub CommandButton1_Click()
Dim dataInput As Worksheet
Dim dataArchive As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Set dataInput = ThisWorkbook.Worksheets("Input")
Set dataArchive = ThisWorkbook.Worksheets("Archive")
lDestLastRow = dataArchive.Cells(dataArchive.Rows.Count, "A").End(xlUp).Offset(1).Row
dataInput.Range("C2:C21").Copy
dataArchive.Range("A" & lDestLastRow).PasteSpecial Transpose:=True
End Sub

How to get macros to work with changing sheet/workbook names

I'm writing a code to have information copied from "Workbook1" and pasted to "Master Worksheet". The macro works but instead of hardcoding the worksheet and workbook name I want to have it reference the cells in the "Macro" tab of "Master Worksheet.xlsx" that will specify the worksheet and workbook name. Similar to how I did it for Set survey = in line 2. This is because the worksheet and workbook name may change. I've been trying for quite a while but haven't had any success.
Dim survey As Workbook
Set survey = Workbooks.Open(Filename:=Sheets("Macro").Range("B5").Value & "\" & Sheets("Macro").Range("B6").Value)
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Set wsCopy = Workbooks("Workbook1.xlsx").Worksheets("Sheet1")
Set wsDest = Workbooks("Master Worksheet.xlsm").Worksheets("Survey Answers")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("J3:AQ" & lCopyLastRow).Copy _
wsDest.Range("A" & lDestLastRow)
Workbooks("Workbook1.xlsx").Close SaveChanges:=True
Assuming the Macro worksheet is located in the Master Worksheet workbook, this should work for you.
Sub ImaMacro()
Dim wbDest As Workbook: Set wbDest = Workbooks("Master Worksheet.xlsm")
Dim wbCopy As Workbook: Set wbCopy = Workbooks("Workbook1.xlsx")
Dim wsDest As Worksheet: Set wsDest = wbDest.Worksheets("Survey Answers")
Dim wsCopy As Worksheet: Set wsCopy = wbCopy.Worksheets("Sheet1")
Dim survey As String
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
survey = wbDest.Sheets("Macro").Range("B5").Value & "\" & wbDest.Sheets("Macro").Range("B6").Value
Workbooks.Open Filename:=survey
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("J3:AQ" & lCopyLastRow).Copy Destination:=wsDest.Range("A" & lDestLastRow)
Workbooks("Workbook1.xlsx").Close SaveChanges:=True
End Sub

Copying a not so large excel table from another workbook causes issue with defined range

So I had a prefect sample macro to open a workbook, copy a table to "Feuil1" on another workbook, copy the table on a new sheet and clean up "Feuil1" for another use. Now that I try to scale it up, for some reason, it does copy the defined range but instead of just using range B2:EA201 as coded, Excel forces itself to EA201201 for some stupid reason.
Using ctrl+End brings me to EA201201 which has no formatting or value so i'm at a loss...
Thinking it might have to do with a double letter column, as i've never used that before?
Would you know whats happening?
Workbooks.Open fileName:="C:\FilePath\ClasseurX.xlsm"
Application.Wait (Now + TimeValue("0:00:05"))
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Set wsCopy = Workbooks("ClasseurX.xlsm").Worksheets("Synthèse")
Set wsDest = Workbooks("ClasseurPrimaire.xlsm").Worksheets("Feuil1")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
wsCopy.Range("B2:EA201" & lCopyLastRow).Copy _
wsDest.Range("B" & lDestLastRow)
Workbooks("ClasseurX.xlsm").Close SaveChanges:=False
ThisWorkbook.Activate
Dim WSCount As Long
WSCount = Worksheets.Count
'
ActiveWorkbook.Sheets("Feuil1").Copy _
After:=ActiveWorkbook.Sheets(WSCount)
Sheets("Feuil1 (2)").Name = "NewSheet" & WSCount + 1
ActiveWorkbook.Sheets("Feuil1").Activate
Range("B2:EA201").Clear
End Sub

How to import second workbook, get its sheet and paste it to my current sheet

I'm looking for a complex solution to reading sheets from existing workbooks in chosen directory and appending to my existing single sheet in my main workbook. Location of input files could be changed, so I think it's better to use OpenFile methods and get files paths automatically.
The case is, that I have e.g. 500 downloaded workbooks from statistical office, every one of them includes only one sheet, and structure of the data is always the same. The same columns, the same types of data inside. Generally one subject of my research.
I found this example (https://www.excelcampus.com/vba/copy-paste-another-workbook/ - "Pasting Below the Last Cell") but I don't know how to change the source of location.
My current code is:
Sub openAndCopyData()
Dim importedFile As Variant
importedFile = Application.GetOpenFilename(FileFilter:="Excel Files,*.xlsx*;")
If importedFile <> False Then
Workbooks.Open Filename:=importedFile
End If
Dim sheetToCopy As Worksheet
Dim sheetToPaste As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Set sheetToCopy = importedFile.Sheets("Sheet1")
Set sheetToPaste = ThisWorkbook.Sheets("Sheet1")
lCopyLastRow = sheetToCopy.Cells(sheetToCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = sheetToPaste.Cells(sheetToPaste.Rows.Count, "A").End(xlUp).Offset(1).Row
sheetToCopy.Range("A2:D" & lCopyLastRow).Copy _
sheetToPaste.Range("A" & lDestLastRow)
End Sub
I wish to get appended data inside my main sheet after import every one of my files, because of its parallel structure. If it will works, I will introduce filter methods and other improvements.
if the objective of your question is to loop through all the selected files for Copying then may try
Sub openAndCopyData()
Dim importedFile As Variant
'importedFile = Application.GetOpenFilename(FileFilter:="Excel Files,*.xlsx*;")
importedFile = Application.GetOpenFilename("Excel Files,*.xlsx*;", 1, _
"Select Files to Copy", "Get Data from Files", True)
If TypeName(importedFile) = "Boolean" And Not (IsArray(importedFile)) Then Exit Sub
Dim sheetToCopy As Worksheet
Dim sheetToPaste As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim i As Long
For i = 1 To UBound(importedFile)
Set Wb = Workbooks.Open(importedFile(i))
Set sheetToCopy = Wb.Sheets("Sheet1")
Set sheetToPaste = ThisWorkbook.Sheets("Sheet1")
lCopyLastRow = sheetToCopy.Cells(sheetToCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = sheetToPaste.Cells(sheetToPaste.Rows.Count, "A").End(xlUp).Offset(1).Row
sheetToCopy.Range("A2:D" & lCopyLastRow).Copy _
sheetToPaste.Range("A" & lDestLastRow)
Wb.Close False
Next
End Sub
code is tested with makeshift data files.

Resources