Makro til at flytte eller kopiere data mellem Excel-workbooks

Denne artikel vil lære dig at kopiere eller overføre data mellem regneark i Microsoft Excel ved hjælp af VBA. I dette særlige eksempel vil vi også lære dig at kombinere data ved hjælp af en tilføjende forespørgsel. Denne kombination af opgaver giver dig mulighed for at kombinere data i eksisterende regneark for lettere analyse.

Makro til at flytte eller kopiere data i Excel

Lad os tage et tilfælde, hvor du skal kopiere data fra en projektmappe og derefter ændre indholdet til en anden projektmappe. I dette eksempel har workbook 1 (kildearbejdsbogen) 1 2 3 4 5 og workbook 2 har 6 7 8 9 0 .

Efter at have kørt makroen, skal workbook 2 have 6 7 8 9 0 1 2 3 4 5 . Formaterne i begge workbooks er de samme.

Her er en makro, der kunne overføre og tilføje dine data. (Sørg for at du læser NOTE i koden):

 Sub CopyData ()
Dim sBook_t As String
Dim sBook_s As String
Dim sSheet_t As String
Dim sSheet_s As String
Dim lMaxRows_t så længe
Dim lMaxRows_s As Long
Dim sMaxCol_s Som String
Dim sRange_t Som String
Dim sRange_s As String
sBook_t = "Måldata WB- Kopier data til WB.xls"
sBook_s = "Kildedata WB - Kopier data til WB.xls"
sSheet_t = "Mål WB"
sSheet_s = "Source"
lMaxRows_t = Arbejdsbøger (sBook_t) .Sheets (sSheet_t) .Cells (Rows.Count, "A"). Slut (xlUp) .Row
lMaxRows_s = Arbejdsbøger (sBook_s) .Sheets (sSheet_s) .Cells (Rows.Count, "A"). Slut (xlUp) .Row
sMaxCol_s = Arbejdsbøger (sBook_s) .Sheets (sSheet_s) .Cells (1, Columns.Count) .End (xlToLeft) .Address
sMaxCol_s = Mid (sMaxCol_s, 2, InStr (2, sMaxCol_s, "$") - 2)
Hvis (lMaxRows_t = 1) Så
sRange_t = "A1:" & sMaxCol_s & lMaxRows_s
sRange_s = "A1:" & sMaxCol_s & lMaxRows_s
Workbooks (sBook_t) .Sheets (sSheet_t) .Range (sRange_t) = Arbejdsbøger (sBook_s) .Sheets (sSheet_s) .Range (sRange_s) .Value
Andet
sRange_t = "A" & (lMaxRows_t + 1) & ":" & sMaxCol_s & (lMaxRows_t + lMaxRows_s - 1)
sRange_s = "A2:" & sMaxCol_s & lMaxRows_s
Workbooks (sBook_t) .Sheets (sSheet_t) .Range (sRange_t) = Arbejdsbøger (sBook_s) .Sheets (sSheet_s) .Range (sRange_s) .Value
' ###################### BEMÆRK #################
'Følgende linjer skal bruges, hvis serienummeret også skal rettes, i stedet for at blive kopieret
'Hvis det ikke er nødvendigt, skal du slette linjen nedenfor
Arbejdsbøger (sBook_t) .Sheets (sSheet_t) .Range ("A" & lMaxRows_t) .AutoFill Destination: = Arbejdsbøger (sBook_t) .Sheets (sSheet_t) .Range ("A" & lMaxRows_t & ": A" & (lMaxRows_t + lMaxRows_s - 1)), Type: = xlFillSeries
Afslut Hvis
Slutdel